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ABSTRACT 

In an attempt to bring the ML-style type inference to the C programming 
language, Smith and Volpano developed a type system for a dialect of C, called 
PolyC [SmV96a] [SmV96b]. PolyC extends C with ML-style polymorphism and a 
limited form of higher-order function. 

Smith and Volpano proved a type soundness theorem that basically says that 
evaluation of a well-typed PolyC program cannot fail due to a type mismatch. The 
type soundness proof is based on an operational characterization of a special kind of 
semantic formulation called a natural semantics. This thesis presents an alternative 
semantic formulation, called a transition semantics, that could be used in place of the 
natural semantics to prove type soundness. The primary advantage of the transition 
semantics is that it eliminates the extra operational level, but the disadvantage is 
that it consists of many more evaluation rules than the natural semantics. Thus, it 
is unclear whether it is a suitable alternative to the two-level approach of Smith and 
Volpano. 

Further, the thesis gives the first full type inference algorithm for the type 
system of PolyC. Despite implicit variable dereferencing found in PolyC, the algorithm 
turns out to be a rather straightforward extension of Damas and Milner’s algorithm 
W for functional languages [DaM82]. The algorithm has been implemented as an 
attribute grammar in Grammatech’s SSL and a complete source code listing is given 
in the Appendix. 
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The computer program in the Appendix is supplied on an “as is” basis, with 
no warrantees of any kind. The author bears no responsibility for any consequences 
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I. 



INTRODUCTION 



If one studies some of the well-known algorithms in Computer Science carefully, 
it becomes clear that some do not make any assumptions about the structure of the 
objects they manipulate. In other words, the algorithm can be generalized to objects 
of infinitely many different types. For instance, a sorting algorithm works for any type 
of value provided that an ordering relation can be defined for the values of the type. 
Also, a function, say length, that finds the length of a list object, is not concerned with 
the structure of the list elements. The result is always a natural number regardless 
of the type of the elements in the list. So the length function is polymorphic in the 
sense that it can work on infinitely many different types. What we gain from this 
generalizability property is that the function can have the same source code, or for 
that matter, the same executable(binary) for each different type of list. 

An implementation of length in ML is given by the program below: 

fun length [] = 0 

| length (x :: xs) = 1 + length xs ; 

How can we express this polymorphic behaviour in the type of length ? Since the type 
of the list elements is not relevant to the computation, we introduce a type variable 
to denote the type of list elements and bind it with a universal quantifier. The type 
of length is then written as 

V7.7 list — » int . 

By instantiating the type variable 7 in this type formula with different types, we 
can specialize the type of the function for different lists. For instance, following type 
formulae show two different specializations, one for integer list, and one for real list: 

int list — » int 
real list — » real 
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We contrast different forms of polymorphism in modern programming lan- 
guages below. 

A. MACRO-BASED POLYMORPHISM 

Ada and C++ implement the idea of polymorphism in the form of Ada generics 
and C++ templates. In these languages, a type parameter for each of the polymorphic 
type variables has to be specified explicitly. Before applying an Ada generic function 
to a value of type r, one has to create a specialized instance of the function for type 
r explicitly in the source program. In C++, instantiation is done by the compiler 
vice the user; but the programmer has to provide the actual type with which the 
parameterized type variable will be instantiated. 

The reason for the earlier specialization requirement is that, in these languages, 
only the same source code is used for a polymorphic function. But for each different 
type of argument, different executable code is generated. This kind of polymorphism 
is syntactic, since the generic instantiation is done at compile time with actual-type 
values that must be available at compile time. Thus, a generic procedure can be 
considered as an abbreviation for a set of monomorphic procedures with the same 
behaviour. This is called macro-based polymorphism. An alternative to macro- 
based polymorphism is parametric polymorphism, as used in Standard ML. The key 
difference is that polymorphic functions have an evaluation semantics. Moreover, 
the same executable code in addition to the same source code can be used for a 
polymorphic function. 

B. ML-STYLE POLYMORPHISM 

ML does not require programs to be annotated with types by the program- 
mer; instead, the type of a program is inferred by the compiler without sacrificing 
the polymorphism. ML-style polymorphism will be discussed in the context of the 
Hindley/Milner system since the ML type system is based on it. 
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C. TYPE SYSTEMS AND TYPE SECURITY 



Although we earlier assigned types to the function length , we did not explain 
how these types can be found in a systematic way since it is not always the case that 
programmers construct type-correct programs. In general, we prefer languages that 
verify the type correctness of programs statically, by checking the type correctness of 
every term of a program rigorously (strong typing). The main aim of strong typing 
is to ensure that the values are treated appropriately according to their structures, 
so that the evaluation of a program does not abort because of type errors. If 1 + true 
does not make sense with respect to the semantics of a language then one expects 
the compiler find this error before the evaluation of the program. For instance, if + 
denotes the addition of two integer values, then at compile time it should be ensured 
that in an application of + , the parameters are terms of integer type. So we need 
some system of rules which tells us how to give a type to each kind of term in the 
language. 

Such a rule system is known as a type system for the language. Most of the 
type systems are written as natural deduction systems. Below is a typical typing rule 
for function application: 



A b e\ : Ti — » r 2 , A b e 2 : r a 



A h ei e 2 : r 2 



In this rule, 

A\~ e i : Ti — » T 2 

is called a type judgement and we say that ej has the type T\ — ► r 2 with respect to 
the assumption set A. Type information for the free identifiers of ei is taken from 
the assumption set A 1 . If there is no type assumption for a free identifier in the 
assumption set then we say ei is not well-typed or is ill-typed. We say that a term e 



1 When the language is extended with imperative features, A has to be extended with the as- 
sumptions about the type of memory addresses. This issue will come up in Chapter II. 
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is well-typed with respect to A if there is a type r such that A h e : r. An assumption 
set is also called a type environment. 

In an explicitly-typed programming language, where the programs are anno- 
tated with type information, type checking ensures that type annotations are consis- 
tent with the type system. On the other hand, the types of programs including the 
parameterization of types can be inferred statically by the compiler without requiring 
any type annotations in the source code. This idea is one of the reasons for the huge 
success of ML, which does type inference instead. 

We want programs to run without run-time type errors. For this reason we 
develop two orthogonal systems of rules, namely a type system and a semantics. If the 
type system types a program correctly then the evaluation of this well-typed program 
does not get stuck due a type error. The security from run-time type errors is known as 
the soundness of a type system. The type-soundness proof of a purely functional type 
system is typically more straightforward than that of an imperative type system with 
first-class references(pointers), first-class functions, and polymorphism. Coexistence 
of first-class references and polymorphism is the main source of difficulty, and it 
requires a precise formulation of the polymorphic treatment of references as well as 
a careful formulation of the semantics of a language. Damas’s faulty proof of a type- 
soundness theorem [Dam85] is an illustration of this difficulty [Tof90]. 

1. Hindley/Milner Type System 

Hindley’s type discipline [Hin69] introduces type variables in type expressions 
without any quantification. Later, Milner introduced quantification of type variables 
[Mil78]. Damas and Milner gave an application of these ideas in a purely functional 
setting [DaM82]. The Hindley/Milner type system has three important properties: 
parametric polymorphism , type inference and soundness and completeness of type in- 
ference. 
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a. Parametric Polymorphism 

The polymorphism used in Hindley /Milner system is also called let 
polymorphism , , because polymorphic functions are allowed only in the local scope of 
a let construct together with a notion of instantiation. In 

let x = t\ in e^ , 

if ei has the type r with respect to A then x is assumed to have type a, which is 
found by quantifying the type variables that occur in r but do not occur free in the 
assumption set A. Then x binds all free occurrences of x in e2, each of which has as 
its type an instance of a. 

The Hindley/Milner system imposes a restriction on the quantification: 
all type formulae have to be in prenex normal form ; in other words, quantification 
must be done at the outermost level. A type formula in prenex normal form is also 
called a shallow type. 

It should be noted that let x — e\ in e2 can be thought of as an abbre- 
viation for (Ax.e2)ei as fax as the evaluation of these two constructs are concerned. 
But there is a difference between them when it comes to how they are treated by the 
type system. In let x = e\ in e2 , ei can be typed polymorphically, but in (Ax.e2)ei, 
e\ has to be monomorphic, since otherwise the type formula computed for it would 
not be in prenex normal form! Assume we give e\ the type a , which is universally 
quantified over some type variables, and e2 the type r. Then Ax.e 2 has to be given 
the type a — *■ r, which is clearly not in prenex normal form. 

b. Type Inference 

There is an efficient algorithm, called W [DaM 82 ], for the type sys- 
tem. W determines whether a given program is well-typed and infers the most gen- 
eral (principal) type for it. 

Starting from the leaves of the parse tree of a program with an empty 
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assumption set 2 , W implicitly annotates the program with type information and, 
at the end, either finds the principal type of the program, if the program is well- 
typed, or fails. Roughly speaking, a principal type is one from which all other types 
of the program can be derived. In the next chapter we will show, in detail, how an 
extension of W infers types for well-typed programs in Polymorphic C. Restricting 
the type formulae to prenex normal form allows the use of Robinson’s first order 
unification algorithm [Rob65]. 

c. Soundness and Completeness 

In [DaM82] it is shown that W is sound, in the sense that it finds types 
only for well-typed expressions, and complete, in the sense that if a program is a 
well-typed then W finds the most general type for it. 



2 Actually, a type assignment process never starts with an empty assumption set if there are 
built-in operations in the language but we would like to consider the emptiness of the assumption 
set in terms of adding a new assumption to the set during the process of type assignment. 
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II. 



THE POLYMORPHIC C LANGUAGE 



This section gives an overview of Polymorphic C. Hereafter we use PolyC 
instead of Polymorphic C as a shorthand. The reader should see [SmV96a] for a 
detailed account of PolyC. 

PolyC is designed to incorporate an advanced polymorphic type system, si- 
miliar to those designed as extensions to the core-ML type system, into the widely 
used imperative programming language, C. Unlike other extensions, the PolyC type 
system also captures polymorphic typing of first class pointers. 

PolyC is semantically very close to K&R C [KR78], with the same pointer 
operations, including the address of &, the dereferencing *, and pointer arithmetic. 
The main design rationale was to bring ML-style polymorphism and type security to 
C while keeping the flexibility and simplicity of C. Variables in PolyC are second class 
and implicitly derefenced, while pointers are first class and explicitly dereferenced by 
the * operator. 

As a new feature, functions are first class citizens in PolyC, and, as in C, 
function applications are implemented on a stack without use of static links or displays 
by imposing a restriction on functions: The free identifiers of a function must be 
declared at top level; that is, the scope of the declaration must extend all the way to 
the end of the program[SmVo95]. In C, no automatic variable 1 can occur free in a 
function declaration so that a function declaration is closed with respect to the top- 
level (global) identifier set. PolyC establishes the same property via this restriction 
by ensuring that a lambda-bound identifier, or an identifer bound by a let, letvar or 
letarr declaration whose scope does not extend to the end of the program, does not 
occur free in a function. In the program below, the scope of y does not extend to the 



of 



1 A variable that is created as a result of a function application. In other words, the local variables 
a function including its formal parameters. 
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end of the program, so A z.z+y is not closed with respect to top-level identifiers. 

letvar x := letvar y := 5 in A z.z + y 
in ... 

But this restriction has another consequence: Currying of functions is not al- 
lowed anymore. An attribute grammar enforcing the restriction is given in Appendix. 

PolyC does not distinguish between commands and expressions. Every term 
of the language is an expression. A subset of expressions, however, are distinguished 
as Values, which are the syntactic values 2 of the language. The core syntax is given 
below. 

(Expr) e ::= v \ e(ei,...,e„) | e a := e 2 [ 

ke | *e | ei + e 2 | ei[e 2 ] | ei;e 2 | 

while ei do e 2 | 

if ei then e 2 else e 3 | 

let x = ei in e 2 | 

letvar x := e i in e 2 | 

letarr x[ei] in e 2 | 

(o,l) 

( Values ) v ::= x \ c \ Xxi, . . . ,x n . e | (a,0) 

Meta-variable x ranges over identifiers, c over literals (such as integer literals and 
unit), and a over addresses. To be able to catch pointer errors in the semantics, an 
address is designed as a pair (z, j), where i is a segment and j is an offset in that 
segment. The lifetime of a cell ends when the scope of the identifier to which it is 
bound ends. 

Since core PolyC does not support overloading, + denotes only pointer arith- 
metic and * denotes dereferencing. The construct letvar binds x to a new cell 

Syntactic values correspond to non- expansive expressions of [Tofte90], where evaluation of a 
non-expansive expression does not extend the domain of the store function. 
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initialized to value of ei; the scope of binding is and the lifetime of the cell ends 
after the evalution of e 2 - If e.\ has type r then x has type r var. Analogously, the 
construct letarr binds x to a pointer to the first cell of n consecutive uninitialized 
cells where n is a positive integer found by the evaluation of ei; the scope of x is e 2 , 
and the lifetime of the array ends after e 2 is evaluated. 

Having functions as first class citizens leads to a more flexible syntax than that 
of C. In addition to named functions, users can define anonymous functions easily 
anywhere in the program such as 

let id — Xx.x in id(Xy.y + 1). 

PolyC does not have an explicit syntax to create uninitialized identifiers of 
pointer type. But it unifies array types and pointers, as in C. Then declaring an 
array of size 1 is the declaration of an uninitialized pointer type identifier. 

Another subtle syntactic difference is in the treatment of the formal parameters 
of a function. In C, formal parameters are considered as local variables of a function, 
whereas they are treated as constants in PolyC. But it is not hard to achieve a C-like 
treatment by declaring new local variables in the body of the function and initializing 
them to the values of the formal parameters. Below, a C function and its PolyC 
version are given in order. 



int f(int x){. . . return x; } 
let / = Ax.letvar x := x in x in ... 

A. THE TYPE SYSTEM 

ML stratifies the types into two levels: the ordinary r — types ( data types ) 
and a — types ( type schemes). PolyC adds another level to this stratification, namely 
p — types ( phrase types ) to establish the second-class status of variables. Types of 
PolyC are given below [SmV96a] : 
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T 



T 



( data types) 
( type schemes) 
(phrase types) 



::= a | int \ unit | r ptr | ^ x • ■ • X r„ -♦ 

a ::= Va . a | r 

p ::= a | r var 

Meta variable a ranges over type variables. 

The type system is designed as a natural deduction system to assign types to 
expressions. It is given in Figure 1 [SmV96a]. 

In Section B, we saw that the type of a term is found with respect to an 
assumption set A, where A ranges over identifiers and assigns types to free identifiers 
of a term. Having A range over identifiers only is adequate for sound typing in a 
functional setting, but if the language includes assignable locations, then we have to 
be able to implicitly type a location, regarding the value stored in it, to get a handle 
on the soundness of the type system. Intuitively, a location must be given a monotype 
since we can not store different types of values in a location. A thorough discussion 
of the difficulties with references in a polymorphic type system is given in [Tof90]. As 
given in Figure 1 , typing judgements have the form 

A;q h e : p, 

meaning that expression e has type p, assuming that 7 prescribes phrase types for 
the free identifiers of e and A prescribes data types for the variables and pointers 
in e. More precisely, meta-variable 7 ranges over identifier typings, which are finite 
functions mapping identifiers to phrase types; j(x) is the phrase type assigned to x 
by 7 and ~][x : p ] is a modified identifier typing that assigns phrase type p to x and 
assigns phrase type -y(x') to any identifier x' other than x. Similiar conventions apply 
to A(x) and A[x : p\ [SmV96a]. 

Generalization of data type r with respect to A and 7 is denoted by Close ^(r) 
and is equivalent to the type scheme Vd . r, where a is the set of all type variables 
occurring free in r but not in A or in 7 . We write A b e : r and Close\(r) when 7 = 0. 
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(var-id) 


A; 7 b x : r var l{ x ) = T var 


(ident) 


A; 7 \- x : r l{ x ) > r 


(ptr) 


A ; 7 •"((*>.?), °) : r P tr K i ) = T 


(var) 


7 I" ((*,;), 1): T var A (») = t 


(LIT) 


A; 7 b c : int c is an integer literal 




A; 7 b unit : unit 


(—►-intro) 


A;7[zi : t u . . . ,x n : r n ] b e : r 

A; 7 b Asi, . . . , x n . e : ri x • • • x r n — ► r 


(— >-elim) 


A; 7 h e : ri x • • • x r n — ► r, 
A; 7 h e,- : r,-, 1 < ? < n 
A; 7 b e(ei,...,e n ) : r 


(let-val) 


A; 7 h v : 17, A; 7(2: : C/oseA ;7 (r 1 )] b e : r 2 
A; 7 b let x = v in e : r 2 


(let-ord) 


A; 7 •“ ei : rj , A; 7(2: : Tj] b e 2 : t 2 
A; 7 b let x = t\ in e 2 : r 2 


(letvar) 


A; 7 b t\ : ri, A; 7(2: : 17 var] b e 2 : r 2 
A; 7 b letvar x := ei in e 2 : r 2 


(letarr) 


A; 7 b : ini, A; 7(2 : 77 pir] b e 2 : r 2 
A; 7 b letarr x[ei] in e 2 : r 2 


(r-val) 


A; 7 b e : r var 
A; 7 b e : r 


(l-val) 


A; 7 b e : r ptr 
A; 7 b *e : r var 


(address) 


A; 7 he:r var 
A; 7 b &e : r ptr 


(assign) 


A; 7 b ej : r rar, A; 7 b e 2 : r 



A; 7 I" ei := e 2 : t 



Figure 1. Rules of the Type System, continued next page 
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(arith) 


A; 7 b e 1 : r ptr , A; 7 K e2 : int 


(subscript) 


A; 7 h ei + e 2 : r ptr 

A; 7 F ei : r ptr , A; 7 b e 2 : int 


(while) 


A; 7 \~ ei[e2] : r var 

A; 7 h ei : int , A; 7 b : t 


(compose) 


A; 7 h while t\ do e 2 : unit 
A; 7 F Ci : ri A; 7 F e 2 : r 2 



A; 7 I" ei;c 2 : r 2 



Figure 2. Rules of the Type System, cont. 

Typing a let construct is done via two rules, namely LET-VAL and LET-ORD. 
If ei is a syntactic value then LET-VAL is used and x is given a phrase type by 
genaralizing the type of ej. On the other hand, LET-ORD is defined for the cases 
where e\ is not a syntactic value and no type generalization is allowed. Regarding 
these two rules, all of the type variables in PolyC can be seen as imperative(weak) 
when compared to Standard ML type system [Tof90]. 

1. Examples of Type Inference 

Consider the program 

let id = Xx.x in id(Xy.y + 1) ; id( 3 ) . 

We start with empty domains for A and 7. The LET-VAL typing rule is the first one 
to start with since Xx.x is a value. By the first premise of LET-VAL, Xx.x is given 
the type a — * a. We extend 7 with x : \/a.a —> a. by closing a — * a with respect 
to A and 7, and try to type the sequence id(Xy.y + l);id( 3 ). The first expression of 
the sequence is typed using — »-ELIM. We instantiate id as /? — » /3 and Xy.y + 1 is 
given the type £ ptr — » £ ptr. Rule — >-ELIM requires /? and £ ptr be the same, so we 
unify them with representative type £ ptr. The second expression is also typed by 
— >-ELIM. We instantiate id to £ — ■> £ this time, and 3 has type int. By — »-ELiM, £ 
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and int are unified to int. So the result of the application has type int. Then by 
COMPOSE, id(Xy.y + 1 ); id( 3 ) is given the type int. Since, the hypotheses of LET-VAL 
are satisfied, it is deduced that the program has the type int. 

The program below shows how the type system prevents memory locations 
from being treated polymorphically. 

letvar id := Xx.x in id := Xy.y + 1 ; let id' = id in id'( 3) 

We start with the LETVAR typing rule and give the type a — » a to Xx.x. Then we 
extend 7 with id : (a —>■ a) var and try to type the body of letvar, which is a sequence. 
The first expression of the sequence is typed using ASSIGN. The type (a — > a) var is 
given to id by 7, and Xy.y + 1 is given the type 0 ptr — > (3 ptr . By ASSIGN, a a 
and 0 ptr — ► 0 ptr must be the same. So we unify a and 0 ptr with representative 
type 0 ptr. Finally, the assignment is given the type 0 ptr — > 0 ptr and 7 gives the 
type (0 ptr — ► 0 ptr ) var to id from now on. 

The second expression of the sequence is a let expression. Since id is an 
identifier we use the LET-VAL typing rule. The type ( 0 ptr — » 0 ptr) var is given 
to id by 7. Since id is in an r-value context, we use rule R-VAL and find the type 
0 ptr — * 0 ptr for id. Then we extend 7 with id' : Close\.^{0 ptr — > 0 ptr). 0 occurs 
free in 7 by the fact that it occurs free in the type judgement id : ( 0 ptr — > 0 ptr) var 
, so Close\ n (0 ptr — ► 0 ptr) = 0 ptr — » 0 ptr. Now, we try to type the body of the 
let expression which is the application id'( 3). The type 0 ptr — * 0 ptr is given to 
id 1 by 7 and 3 has the type int. But then — »-ELIM requires 0 ptr and int be the 
same which is not possible. So we conclude that this application is not typable and 
therefore the program is untypable. 

Having first class pointers in the language can lead to the occurrence of dan- 
gling pointers. To preserve the flexibility and expressiveness of C, PolyC does not 
prevent the dangling pointers but the semantics catches the dereferencing of a dan- 
gling pointer. The program below shows how a reference location escapes from its 
scope by returning the address of the variable y in the body of the inner letvar 
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expression, and how the type system assigns a type to this program. 

letvar :r := letvar y := A z.z in &t/ in (**)(3) 

We start with the LETVAR typing rule to type the program. The first premise of 
LETVAR requires us to type the inner letvar expression, letvar y A z.z in hy . By 

a second use of LETVAR, we give the type a — » a to A z.z, and then by extending 7 
with y : (a — ► a) var , the body of inner letvar , hy, is given the type (a —* a) ptr. 
So it is deduced that the inner letvar has the type (a — * a) ptr . Now 7 is extended 
with x : ((a — ► a) ptr ) var , and we try to type the body of the outer letvar. Since 
it is an application, we use — »-ELIM. We type *x by first using R-vaL, then L-VAL 
followed by R-VAL again giving type a —> a. Since 3 has the type int, we deduce the 
type int for the application and also for the program itself. 

In Chapter III we will show how the semantics prevents the evaluation of this 
program by catching the dereferencing of the dangling pointer stored in x. 
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III. 



THE TYPE-INFERENCE ALGORITHM 



In this chapter we present the type-inference algorithm W c . It is similiar to 
Milner’s algorithm W [DaM 82 ], which is based on unification of type expressions. We 
also present an example type inference produced by the computer implementation of 
W c . We first give some definitions about substitution and unification. 

A. SUBSTITUTION AND UNIFICATION 

A substitution S is a finite set of the form 

[ t i/a U T2/a 2 ,...,T n /a n \ 

where the variables a t - (1 < i < n) are distinct. Sp is called the application of 
substitution S to type expression p. The result of Sp is another type expression p', 
obtained from p by replacing simultaneously each free occurrence of the variable a;, 
1 < f < n in p by r; , renaming the bound variables of p if necessary, p' is called an 
instance of p. Note that p and p' can be the same if no a,- occurs in r. 

We often write S2{S\p) or simply S2S1P for the application of the composition 
Si o S2 to p. An empty substitution is written as []. 

A substitution S is called a unifier for type expressions p\ and P2 if Sp\ = Sp2- 
We say pi and P2 are unifiable if there is a unifier for them. 

A unifier S is called the most general unifier of pi and P2 if for every other 
unifier S' of pi and p 2 there is a substitution S" such that 

S' = So S". 

Unification of type expressions is implemented using Robinson’s first order 
unification algorithm, which returns a substitution U, where U is the most general 
unifier of a pair of type expressions p\ and p 2 given as the arguments to the algorithm 
[Rob 65 ]; if pi and p 2 are not unifiable then the algorithm fails to return such a 
substitution. 
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B. ALGORITHM W c 

W c takes two input arguments, 7 and e, and returns a pair ( S , r). As defined for 
the type system, 7 is a finite function mapping identifiers to phrase types. The second 
input argument e is the expression whose type is to be inferred, S is a substitution 
and r is the type inferred for e by W c . The type returned by W c is a r — type in that 
it is called only in r-value contexts. Since locations do not occur in user programs, 
we do not use a location typing A in W c . Only 7 is needed to do type inference. 

W(7, e) is defined by cases: 

1. e is 2 

case 7(2) = Vo:i , . . . , a n .r 

return ([ ], [/?i/a,]r) where is new for each 1 < i < n 
case 7(2) = t 
return ([ ], r) 
case 7(2) = r var 
return ([ ], -r). 

2. e is A21, . . . , 2 n .ei 

let (Si,Ti) = W( 7(2 j : /?i,..., 2 n : where /Vs are new 

return x • • • x / 3 n ) — > n). 

3 . e is e'(e 1} . . . , e n ) then 

let (S’, t') = W{ru e') 
let (S 1 ,t 1 ) = W(S' 7 ,e a ) 



let (S n , t u ) = W(S n -iS n . 2 • • • 5 i 5 , 7 , e n ) 

let S" = Unify(C 0 T ', (C1T1 X C2T2 X • • • X C' n -ir n _ 2 X X r n ) — »■ /?) 

where ft is new, 
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C t = S n Sn - 1 • • • Si + 1 and 1 < i < n 
return (S n S n - 1 ■ • • SiS', S"/3). 

4. e is let x = ei in e 2 

let (5 1 ,r 1 ) = ^( 7 ,e 1 ) 
if ei is a syntactic value then 
let (S 2 ,r 2 ) = : C?ose5 17 (r 1 )],e 2 ) 

else 

let (S 2 ,r 2 ) = W(Si7[x : Tj], e 2 ) 
return (5 2 5'i,t 2 ). 

5. e is letvar x := ei in e 2 

let (S'i,ri) = W( 7, ei) 

let (5 2 ,t 2 ) = W^S^x : T\ uar],e 2 ) 

return (S 2 Si,r 2 ). 

6. e is letarr x[ei] in e 2 then 

let (S 1 ,r 1 ) = W( 7 ,ei) 
let -9' = Unify ini) 

let (S' 2 ,r 2 ) = W / (S ,, S'i7[x : /?pfr],e 2 ) where /? is new 
return (5 2 S ,, 5'i, r 2 ). 

7. e is *ei then 

let (S l! r 1 ) = hF( 7 ,e 1 ) 
let 5' = Unify(ri, (3 ptr) 
where f3 is new 
return (S'Si , S'j3). 
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8. e is &ei then 

case ei is x 
if 7(2) = Tivar then 
return ([ ], ptr ) 
else fail 
case is *e 2 
let (Sun) = W( 7, e 2 ) 
let S'' = Unify (n 1 fi ptr) where ft is new 
return (S'S\ , S' ft ptr). 

9 . e is ei := e2 then 

case ej is x 
if 7(x) = t var then 
let ( 5 1 ,r 1 ) = W( 7 ,e 2 ) 
let 5 ' = Unify (n , S\t) 
return ( 5 ,/ 5 'i, 
else fail 
case ei is *e' 

let (5 1 ,r 1 ) = ^( 7 ,e / ) 

let S' — Unify (n, ft ptr) where ft is new 

let (S 2 ,t 2 ) = W(S‘S 1 7 ,e 2 ) 

let S" = Unify (t 2 , S 2 S'ft) 

return (S"S 2 S'S 1 , S"r 2 ) 

10. e is ei + e 2 then 

let (S 1 ,n) = W(i,e 1 ) 

let S' = Unify (n, ft ptr) where ft is new 
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let (S 2 ,r 2 ) = W(S , S ll ,e 2 ) 
let S" = Unify (r 2 , int) 
return (S"S 2 S'Si, S"S 2 S'0 ptr) 

11. e is ei; e 2 then 

let (5 i,T!) = W( 7,d) 
let (S 2 ,r 2 ) = W(R l7 ,e 2 ) 
return (5 2 5'i, r 2 ) 

12. e is while ei do e 2 then 
let {S 1 ,T 1 ) = W{i,e 1 ) 
let S' = Unify ( ti, int) 

let (S 2 ,r 2 ) = W(S'S ll ,e 2 ) 
return (S 2 S'Si, unit) 



Function Unify is the implementation of Robinson’s unification algorithm and 
Closes^Ti) in case 4 is the generalization of T\ with respect to the environment 
found after the application of the substitution S\ to 7 . 

Ci in case 3 denotes the composition of substitutions that is applied to the 
type of the z’th actual parameter of a function application, where 1 < i < n and n is 
the number of formal parameters. Co is the substitution composition applied to the 
called function. 

We omit the default arm of case statements for simplicity and it corresponds 
to a fail case of W c . In addition to the explicitly stated fail cases, W c also fails if 
Unify fails to return a substitution or any subinvocation of W c fails. 

Array subscripting ei[e 2 ] is a syntactic sugar for *(ej + e 2 ) so that we do not 
consider array subscripting as a separate case in W c . 
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The algorithm does not explicitly specify how a “new” type variable is obtained. 
We assume that there is a global list of used variables, and that new ones are selected 
from those not in that list. 

1. Sample Type Inference with W c 

An interpreter for PolyC has been written using The Synthesizer Generator 
environment [Gram]. It includes an implementation of W c and the syntax and the 
natural semantics of PolyC given in [SmV96a] with some modifications. Source code 
for the interpreter is given in Appendix. 

Below is an implementation of a HeapSort algorithm in PolyC [Cor90] . The 
type annotations shown as 

id : a 

for selected identifiers only are done automatically by the interpreter. 

let Swap : V * 9.(*9 ptr x *9 ptr — > * 9 ) := A (a, b ) {let temp = !a in 

\a :=!&; 

!6 :=!&; 

end } in 

letvar heapSize : int var := 0 

let Heapify : V * 21.(*21ptr x int x (*21 x *21 — >■ int) — » unit) 

= A(a, i, comp) {letvar left : int var := 2 * i + 1 in 

letvar current : int var := i in 
while left < heapSize — 1 do 
if left < heapSize — 1 

then if comp(a[left],a[left+ 1]) 
then largest := left 
else largest := left + 1 
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fi 



else largest := left 

fi; 

if comp(a[largest ], a[current ]) then 
Swap(ha[largest\ , &a[ current]); 
current := largest ; 
left := 2 * current + 1 
else /e/i := heapSize + 1 
fi 

od 

end 

end 
end } in 

let BuildHeap : V * 29.(*29ptr x int x (*29 x *29 —* int) — * unit) 

= A(a, size , comp) {heapSize := size; 
letvar i := size/2 — 1 in 
while i > 0 do 

Heapify(a , i, comp ) ; 
i := i — 1 

od 

end } in 

let HeapSort : V * 35.(*35 ptr x int x (*35 x *35 —* int) — > unit) 
= A (a, size, comp) {BuildHeap [a, size, comp)] 
letvar i := size — 1 in 
while i > 1 do 
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Swap(foa[i], &a[0]); 
heapSize := heapSize —\ ; 

Heapify(a , 0, comp ); 
i i — 1 

od 

end } in 
letarr a[8] in 
a[0] := 12; 
a[ 0] := 5; 
a[0] := 23; 
a[0] := 8; 
a[0] := 1; 
a[0] := 45; 
a[0] := 17; 
a[0] := 51; 

HeapSort(a , 8, A (a, b ) {a > 6}); 

(a[0], (a[ 1], (a[2], (a[3], (a[4], (a[5], (a[6], a[7]))))))) 

end 

end 

end 

end 

end 

end 

val (1, (5, (8, (12, (17, (23, (45, 51))))))) 

: (int x (int x (int x (int x (int x (int x (int x int))))))) 
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In type expressions, Cartesian product x binds tighter than arrow — *i, where i € 
Natural, is a type variable generated by a global new type variable generator function. 
The second line from the last shows the result of the evaluation of the program and the 
last line shows the type of the program. Here we use * to denote integer multiplication 
vice dereferencing, which is denoted by !, and + denotes integer addition vice pointer 
arithmetic, which is denoted by ®. Type quantification is denoted by V as in the type 
of Swap. 

2. Correctness Criteria for W c 

Due to time constraints on preparation of this thesis, we are not able to pose 
theorems related to correctness of W c and prove them. Roughly speaking, correctness 
of W c should be established by showing that W c is sound (syntactically) and complete. 
By soundness, we mean that if W c succeeds in finding a type for a PolyC expression 
then that type can be derived for the expression in the type system. By completeness, 
we mean that if an expression of PolyC has a type at all then W c will succeed in finding 
a type for this expression which is at least as general. 
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IV. TRANSITION SEMANTICS FOR 

POLYC 

In this chapter we develop a transition semantics (TS) for PolyC that cap- 
tures each single step of the evaluation of an expression. First we will look at the 
motivations behind this type of semantics. 

A. STRUCTURAL OPERATIONAL SEMANTICS OF 
POLYC 

To show the semantic soundness of the type system of PolyC, Smith and Vol- 
pano use the framework of Harper [Har94] and develop the subject reduction property 
using the Structural Operational Semantics(SOS) given in the same paper [SmV96a]. 
But the subject reduction property based on SOS does not expose enough informa- 
tion about the course of evaluation of a program, making it difficult to establish a 
semantic soundess result for the type system. SOS defines a relation between the 
expressions and their normal forms but does not explicitly keep track of step-by-step 
construction of the evaluation tree of an expression. Instead, by using the composi- 
tionality property in a coarse-grained sense, it assumes that in one or more steps the 
evaluation trees created by the subexpressions will constitute the final evaluation tree 
of an expression. If a subexpression fails to evaluate to a value, so does the whole 
expression. But we cannot know exactly how the subexpression got stuck, which is 
a key issue in being able to reason about the semantics and its interaction with the 
type system. SOS admits structural induction on evaluation derivations. 

Gunter [Gun92] strengthens subject reduction for the pure functional pro- 
gramming language PCF by augmenting the evaluation rules with new rules that 
evaluate to a special value, namely tyerr which does not have a type. These rules 
cover the evaluation of possible ill-typed expressions. Since a well-typed expression 
never contains an ill-typed subexpression, then any of the rule instances that occur 
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in the evaluation of a well- typed expression cannot be an instance of one of these new 
rules. Hence, it is not the case that a well-typed expression evaluates to tyerr. So by 
showing that subject reduction holds for the augmented evaluation rules, absence of 
run-time type errors is guaranteed. In addition to the drawback of augmenting the 
evaluation rules, this approach does not give us any information about the nature 
of the other errors that can occur during evaluation of well-typed programs, which 
will be an important issue in an imperative setting with assignable locations and first 
class pointers. 

On the other hand, Smith and Volpano use the combination of subject reduc- 
tion and a lemma, namely the Correct Form Lemma to prove a soundness theorem 
[SmV96a]. The Correct Form Lemma shows the correct syntactic form of a value 
when its type is given. It basically shows the type system is not being silly by giving 
some unexpected type to a term. For example, if a value has type T\ — > r 2 then the 
value is a A — abstraction and not, say, an integer. Also, to get a handle on the 
“progress”of an attempted evaluation, the evaluation rules are re-cast as an instance 
of a recursive function, eval. The Soundness Theorem then shows that if an activation 
of eval aborts, it is due to one of the following four errors [SmV96aj: 

El. An attempt to read or write to a dead address 

E2. An attempt to read or write to a nonexistent address (i, J). Address (i,0) 
always will exist, so the problem is that the offset j is invalid. 

E3. An attempt to read an uninitialized address ( i,j ). 

E4- An attempt to declare an array of size less than or equal to 0. 

But re-casting the evaluation rules as an instance of eval and proving a sound- 
ness result based on the abort conditions of eval seems a little bit informal. What we 
would like to do is to collect more information about the “course” of the evaluation of 
the programs so that we can use more formal techniques to prove a soundness result 
for PolyC. It is for this reason that we explore a transition semantics for PolyC. 
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B. TRANSITION SEMANTICS FOR POLYC 

1. Definitions 

First, we give some definitions used in the transition (evaluation) rules. 

A configuration is a triple (e, g, 8 ) where e is an expression, 8 is an active cell 
indicator , and g is a memory which is a finite function from addresses to values; g 
may also map addresses to dead or uninit, indicating that the cell with that address 
has been deallocated or is uninitialized. The contents of an address a € dom(g) is 
the value g(a), and we write g[a := v ] for the memory that assigns value v to address 
a, and value /u(a') to an address a' ^ a; n[a := u] is an update of g if a 6 dom(g) and 
an extension of ji if a ^ dom(g). 

An active cell is an address whose value is not dead. The natural number 8 
denotes the number of active cells created so far by an expression or by its subex- 
pressions. We use 8 for the purpose of keeping track of the lifetime of memory cells 
that are allocated via letvar and letarr declarations. 

We define a binary relation — * from configurations to configurations to capture 
the single step transitions. If evaluating the closed expression e in memory g with 
respect to 8 results in a new expression e', a new memory g! and a new active cell 
indicator 8\ then 

(e, g, 8) -> (e\ //, 8') . 

We write [e'/x]e to denote the capture- avoiding substitution of e! for all free 
occurrences of x in e and the result of the substitution is another expression of PolyC. 

2. The Transition Rules 

The transition rules are given below: 

(contents) 

(i) a € dom{g, ) and g(a) = v 

((a,l),iJ,,8) -► {v,/j,,8) 
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(deref) 



(I) 


a 6 dom ( fi ) and ji(a) = t? 


(II) 






-> (*e',/x',6') 


(ref) 

(I) 

(II) 

(III) 


(&(a, l),/x,5) -»• ((a,0),/i,S) 
(k * (a, 0), /x, <5) -► ((a, 0), /x, S) 
(e,/x,<5) -> (e', /x', £') 




(& * e, fi, 6) (& * e', /x', <5') 


(offset) 

(I) 


n an integer 


(II) 


(((•.j),0) + n,/ x, <5) -> (((«, j + n),0),/i,<) 
X') 


(III) 


(((*,i),0) + e,n,S) -4 (((*,», 0) + e',/x',£') 
(ei,/x,<5) -> (e', /x', 8') 




(ei + e 2 , /x, S) —* (e' + e 2 , /x', £') 


(apply) 

(I) 

(II) 


((Ax a , . . . , x n . e)(v u ■ ■ ■ , Un), A*, £) -»• (K> • • • 
(e,,x,*)^(eV,£') 



(c(ci, . . • 5 c n ), /x, 6 ) * (c (ci, • • • j c n ), fi , <5 ) 

(in) (e,-, /X, <?) -» (e-, £') 1 < i < n 



((Axi, ...,x n . e)(v 1} i, e,-, . . . , e„), /x, 5) -* 

((Axi, . ..,!*■ e)(vi, . . . , Vi_i, e-, . . . , e n ), //, £') 

(update) 

(i) a £ dom(fi) and /x(a) ^ dead 

((a, 1 ) := v,fi,S) -> (n,/x[a := u],£) 



Je,/x,<^) 
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(n) 


(e', /x', S') 


(hi) 


((a, 1) := e,fi, 6 ) -> ((a, 1) := e',/,6') 
a G and //(a) 7^ dead 


(IV) 


(*(a,0) := v,/x,£) (v,ju[a := v],£) 
(e,/j,, 8 ) -> (e',/x',$') 


(V) 


(*(a,0) := e,(x, 8 ) -> (*(a, 0) := e',/x', 8 ') 
(ei,/x,< 5 ) (e^fx', 8 ') 




(*^1 * ^2? * (*^1 • ^2 7 ^ ) 


(bind) 


(I) 


(let x = v in e,/j,, 8 ) —>■ ([v/x]e,fi, 8 ) 


(n) 


(ei,^,< 5 ) -> (ei, //,£') 




(let a: = ei in e 2 ,/x,6) — » (let x = in e 2 ,^', £') 


(bindvar) 


(I) 


(z, 0) ^ dom(n) 


(n) 


(letvar x := u in e,/x,0) — > 

(letvar x := v in [((£, 0), l)/x]e,/x[(z, 0) :=v],l) 

(z,0) € dom(n) and (z, 0) the last non-dead cell 


(m) 


(letvar x := Vi in v 2 , fi, 1) — >• (n 2 , ^[(i, 0) := dead], 0) 
(ci ,t*, 8 ) -*■ (e\,n', 8 ') 


(IV) 


(letvar x := e a in e 2 ,ix, 8 ) — » (letvar x := e( in e 2 ,/x',6') 
(e,/j,, 8 - 1) -► (e',/x',6') (£ > 0) 




(letvar x := t> in e, /x, 6) — ► (letvar x := n in e', /x', 8 ' + 1) 


(bindarr) 


(I) 


n a positive integer and (z, 0) ^ dom(/x) 


(n) 


(letarr x[n] in e,/x,0) — » (letarr x[rx] in [((z, 0), 0)/x]e, 
/x[(z, 0), . . . , (z, n — 1) := uninit, . . . , uninit], 1) 

(z,rx — 1 ) G dom(/x ) and (z,n — 1 ) the last non-dead cell 




(letarr x[n] in v,/x, 1) — » 

(u, /x[(z, 0), . . . , (z, n — 1) := dead, . . . , dead], 0) 
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(loop) 



(III) (ei ,H,6) -* (ej,/z , ,^ / ) 

(letarr x[ei] in e 2 ,//,£) — * (letarr x[e'^\ in e 2 ,(*■', S') 

(IV) (e, /x, 8 - 1) -» [efi /F, S') (S > 0) 

(letarr x[n] in e,fi,S) —> (letarr x[n] in + 1) 



(l) (ei,/*,£) -» 

(while e\ do e 2 , /x, 6) — > 

(if e'j then e 2 ; while e\ do e 2 else unit,//', S') 



(BRANCH) 

(i) n a nonzero integer 

(if n then e\ else e 2 , /u, 8) — ► (ei,fi,6) 

(il) (if 0 then e\ else e 2 ,/x,<5) — > (e 2 ,/z,6) 

(m) (e!,/x» -> (e'j, //,£') 

(if ei then e 2 else e 3 , /x,5) — » (if e) then e 2 else e 3 ,//,£') 



(compose) 

(i) (v;e,/i,$) -+ (e,/i,5) 



(il) (e t ,^,<?) -» (e;,^,^) 

( e lj ^2) ^) * (®i> ^2) ^ ) 



Meta variable u and x range over values and identifiers, respectively. The 
understanding in rules like DEREF, REF, etc. is that if there are transitions on e and 
v or at least one specific syntactic value then e is understood to be all expressions 
except all values. For instance, DEREF has two rules; (i) defines a transition for pointer 
type values and (il) defines a transition for all other expressions except values. 

Since the lifetime of a memory cell is bounded by the scope in which it is 
activated, the rules have to keep track of the lifespan of each memory cell. In SOS, 
this is easy to do, whereas the solution in TS may seem unintuitive. We introduce 
6 to keep track of the scope information. Notice that in BINDVAR (i), after a cell is 
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allocated for a variable we still keep the letvar 1 construct until the body evaluates to 
a value. When the cell is allocated 8 is incremented so that we can understand that 
this letvar instance has actually allocated a cell and now it is evaluating its body. 
Rules BINDVAR (i) and BINDVAR (iv) show this difference. In BINDVAR (i), the letvar 
expression of the initial configuration has a value v as its t\ and 8 is 0 which means a 
cell has not been allocated yet. Then a new cell for x is allocated and initialized to v, 
and 8 is incremented by one. In BINDVAR (iv), the initial configuration is the same 
as the initial configuration of BINDVAR (i) except that the second premise forces 8 be 
greater than 0 which means that this rule is used only to evaluate the body of letvar. 
Keeping the letvar construct around after we allocate a cell makes the proof search 
part of a letvar transition unnecessarily long, but introducing a new construct would 
force us to augment the type system superficially with a new typing rule for this new 
construct. The evaluation of a program starts with 8 = 0 and ends again with 5 = 0. 

At first glance, one might be tempted to use a variation of p - expressions 
to keep track of the cells being activated [WrF91]. This would not be enough by 
itself, since in PolyC the lifetime of a cell is bounded whereas in [WrF91] a cell has 
unbounded lifetime. 

We assume that memory cells are allocated sequentially from a sufficiently big 
sequence of cells, where the cells are associated with index numbers in an increasing 
order. As defined earlier, an address is a pair of segment and offset numbers and it 
indicates a cell in the memory. When a variable v is created, the cell with the least 
index number from the non-used part of the sequence is initialized to the value of 
this variable, and an address ( i , 0) corresponding to this cell is added to the domain 
of p. Similiarly, when an array x of size n is created then the first n cells from 
the non-used part of the sequence are initialized to uninit and the corresponding 
addresses (i, 0), (i, 1), . . . , (i, n — 1) are added to the domain of p. When the scope of 

1 We will focus on letvar without mentioning letarr separetely; in most cases the same discussion 
is also valid for letarr. 
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the variable v or the scope of the array x ends then these cells are marked as dead, 
but they are still kept in the domain of fx. 

In SOS, a variable declaration and termination are done within a single eval- 
uation rule so that it is easy to know which address is to be marked as dead. But in 
TS, declaration of a variable and termination of it are done via different rules, and the 
address information is not carried to the next transition. Given the memory model, 
it is easy to find out the memory cell to be marked when necessary. Simply search 
through the sequence of cells starting from the high-index numbered end of the used 
part of the sequence, and the first cell that is not marked as dead will correspond 
to the address of the variable whose scope is ending. We call this cell the last non- 
dead cell. In case of an array of size n, the consecutive n cells starting from the last 
non-dead cell are the ones that will be marked as dead. The reason that we have to 
search for the last non-dead cell is because dead locations are not taken away from 
the domain of fx. If an expression e creates a variable x for which the cell indexed i 
is allocated, and if a subexpression of e then creates another variable y, then the cell 
allocated for y has a higher index j and so j will be marked as dead before i since 
the scope of y ends before the scope of x. 

3. Two Examples of Program Evaluation 

Figure 3 shows the evaluation derivation of the program 

letvar x := 1 in letvar y := x in y . 

The evaluation in Figure 3 is completed in six transitions. A transition rule 
name is given inside brackets to indicate the rule used in making the single transi- 
tion that follows it. For example, the first transition is done using the BINDVAR (i) 
rule. The second, third, fourth and fifth transitions are done using an instance 
of BINDVAR (iv). In the proof search, the second transition uses an instance of 
BINDVAR (ill) and CONTENTS, the third transition uses an instance of BINDVAR (i), 
the fourth transition uses an instance of BINDVAR (iv), and the fifth transition uses 
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[bindvar (l)] 

(letvar x := 1 in letvar y := x in y, [], 0) — * 

(letvar x := 1 in [((i x , 0), 1 )/x] letvar y := x in y , [(i x , 0) := 1], 1) 



[contents] 

(((**>0),l),[(i„0) := 1],0) -> (l,[(i*,0) := 1], 0) 



[bindvar (ill)] 

(letvar y := ((**, 0), 1) in t/, [(»*, 0) := 1], 0) — > 

(letvar y := 1 in y,[(i„0) := 1], 0) 



[bindvar (iv)] 

(letvar x := 1 in letvar y := ((i x , 0), 1) in y, \(i x , 0) := 1], 1) — » 

(letvar x := 1 in letvar y := 1 in y, [(i*, 0) : = 1], 1) 



[bindvar (i)] 

(letvar y := 1 in y,[(z x ,0) := 1],0) -> 

(letvar y := 1 in [(i y , 0), l)/y]y, [(i*,0) := 1 , (» v , 0) := 1], 1) 

[bindvar (iv)] 

(letvar x := 1 in letvar y := 1 in y, [(i s , 0) := 1], 1) — » 

(letvar a; := 1 in letvar y := 1 in ((i v , 0), 1), [(i*, 0) := l,(z v ,0) := 1], 2) 



[contents] 

(((i,, 0), 1), [(*„ 0) := 1, (i y , 0) := 1], 0) (1, [(t„ 0) := 1, (i y , 0) := 1], 0) 

[bindvar (iv)] 

(letvar y := 1 in ((i y , 0), 1), [(»*, 0) := 1, (i v , 0) := 1], 1) -» 

(letvar y := 1 in l,[(i*,0) := l,(i y ,0) := 1], 1) 



[bindvar (iv)] 

(letvar x := 1 in letvar y := 1 in ((i v ,0), 1), [(z r ,0) := 1, (i y ,0) := 1] , 2) — » 

(letvar x := 1 in letvar y := 1 in 1, [(i x , 0) := 1, (i y , 0) := 1], 2) 



Figure 3. Sample Program Derivation, continued next page 
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[bindvar (ii)] 

(letvar y := 1 in 1,[(*«,0) := l,(i y ,0) := 1], 1) 

(M(i.,0) := 1, (*», 0) := dead],0) 



[bindvar (iv)] 

(letvar a: := 1 in letvar y := 1 in l,[(i x , 0) := 1 , (z v , 0) := 1],2) — ► 

(letvar x := 1 in 1 , [(i x , 0) := 1 , (t y ,0) := dead], 1], 1) 



[bindvar (ii)] 

(letvar x := 1 in 1, [(z x , 0) := 1, (i y , 0) := dead], 1) — >■ 

(1, [(»„0) := dead, (i y ,0) := dead],0) 

Figure 4. Sample Program Derivation, cont. 

an instance of BINDVAR (ii). The final transition is done with BINDVAR (ii). So the 
letvar expression evaluates to 1. 

Now let’s turn back to the well-typed program 

letvar x := letvar y := A z.z in k,y in(*x)(3) 

of Chapter I Section 2, in which the location of y escaped from its scope via the Sz 
operator and we inferred the type int for this program. Figure 5 shows how this 
program gets stuck due to dereferencing a dead cell. 

The notation denotes the stuck condition of a rule instance. In the sixth 
transition, *((i y , 0), 0) attempts to derefence a dead location, which causes the eva- 
lution to get stuck because there is no possible transition that can be made. The 
first three transitions are done with BINDVAR (ill), where in the proof search the first 
transition uses an instance of BINDVAR (i), the second transition uses the instances 
of bindvar (iv) and REF, and the third transition uses an instance of BINDVAR (ii). 
The fourth transition is done with BINDVAR (i), because ((i y , 0), 0) is a pointer, which 
is a syntactic value and 6 is 0. The fifth transition is done with BINDVAR (ill), where 
the instances of APPLY and CONTENTS are used in the proof search. 
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[bindvar (i)] 

(letvar y := A z.z in &j/,[],0) — *■ 

(letvar y : = A z.z in [((**,, 0), 1 )/y]ky, [(» y ,0) := Xz.z],\) 



[bindvar (ill)] 

(letvar x := letvar y := Xz.z in in (**)(3),0,O)- 

(letvar x := letvar y := Xz.z in &z((i y , 0), 1) in(* x)(3), [(ty, 0) := Xz.z\,\) 



[ref] 

(&((*y, 0), 1), [(*„, 0) := Xz.z], 0) * (((i y , 0), 0), [(i v , 0) := Xz.z], 0) 

[bindvar (iv)] 

(letvar y Xz.z in &((i y , 0), 1), [(i y , 0) := Xz.z],\) — * 

(letvar y := Xz.z in ((i y , 0), 0), [(i v , 0) := Xz.z], 1) 



[BINDVAR (III)] 

(letvar x := letvar y := Xz.z in &((i y , 0), 1) in(* x)(3), [(i y , 0) := Xz.z], 1) — ► 

(letvar x := letvar y Xz.z in ((iy,0),0) in(*x)(3), [(i v , 0) := Xz.z], 1) 



[bindvar (ii)] 

(letvar y := Xz.z in ((i y , 0), 0), [(i y , 0) := Xz.z], 1) -> 

(((i y , 0), 0), [(ty, 0) := dead], 0) 



[bindvar (III)] 

(letvar x := letvar y := Xz.z in ((i y , 0), 0) in(* x)(3), [(i w , 0) := Xz.z], 1) ->• 

letvar x := ((i v , 0), 0) in (*x)(3), [(iy,0) := dead], 0) 



[bindvar (i)] 

letvar x := ((i y , 0),0) in (* *)( 3 ), [(*»> 0) : = dead], 0) 

letvar x := ((i y , 0),0) in [((£„ 0), l)/x] (* z)(3), [(ty, 0) := dead,(i x ,0) := ((i y , 0),0)],1) 



Figure 5. Sample Stuck Program, continued next page 
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[contents] 

(((**> 0),l),[(* v ,0) := dead, (4,0) := ((*' y , 0), 0)], 0) -> 

(((*v> 0)> °), [(*»> 0) : = dead , (4, 0) := ((t y , 0), 0)], 0) 



[apply] 

((* y)( 3), [(*v» °) : = dead > (**, 0) := ((*V» °)> 0)], 0) -»■ 

((*((*»> °)>°))( 3 M(*v>0) : = dead, (4,0) := ((4, 0), 0)], 0) 



[bindvar (ill)] 

letvar x := ((i y , 0), 0) in (* ((4, 0), 1))(3), [(*' y , 0) := dead, 

(**» 0) : = ((*», 0), o)], 1 ) letvar x := ((4, 0), 0) in (* ((*„, 0), 0))(3), 
[(4,0) := dead, (4,0) := ((4, 0),0)], 1) 



(*((4,0)»0)),[(4,0) := dead, (4,0) := ((4, 0), 0)], 0) ■/* 



((* ((*'». 0)> 0))(3), [(4, 0) := dead, (4, 0) := ((4, 0), 0)], 0) ■/> 



letvar x := ((4,0),0) in [((4, 0), \)jx] (* ((4, 0), 0))(3), [(4, 0) := dead, 

(4,0):= ((4,0),0)],1) 



Figure 6. Sample Stuck Program, cont. 

4. The LOOP Rule 

In the preliminary design of the transition semantics of PolyC, we developed 
three rules, given below, to specify the transitions for the while-do construct. 

(LOOP) 

(i) (ei —*■ ( ') (n a nonzero integer) 

(while ei do e2,/x,<5) — > (e 2 ; while t\ do 

(n) (ei ,n,6) -» (0 ,jA&) 

(while ei do ei,ix,6) — > (unit, /a', 5') 
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( IJI ) (ei, 8) — * S') 

(while ei do e 2 , /z, 8) —> (while e\ do e 2 ,^z',<5') 



Gunter develops a transition semantics for an imperative programming lan- 
guage called Simple Imperative Programming Language (SIPL), and rules (ill) and 
(il) above are closely similiar to Gunter’s [Gun92] . There is a subtle difference 
though: ei of while ei do e 2 is not evaluated explicitly in Gunter’s system but its 
value is found by a meaning function in one step. In our system we explicitly evaluate 
e\ and for this reason a third rule had to be added to the system as shown above. But 
in a short time we realized that this third rule was faulty. Assume in an evaluation 
of a program we reach the point of evaluating the expression, 

while (a, 1) := ((a, 1) + 1); 1 do e , 

which increments the value stored in address a and then evaluates the body e. This 
is an infinite loop, since the value of a sequential composition ei;e 2 is the value of 
e 2 and, in this program, e 2 is 1 so the condition is always true. In each iteration, 
(a,l) := ((a, 1) + 1 ) ; 1 and e must be evaluated. But this is not achievable with 
the above rules. The evaluation starts with repeated applications of rule (ill) until 
(a,l) := ((a, 1) + 1); 1 evaluates to the value 1. At this point, the configuration 
is (while 1 do e, fi,8) and rule (i) is applied by resulting in the new configuration 
(e; while 1 do e,^z', <*>'). After some applications of COMPOSE, e evaluates to a value 
and then the configuration (while 1 do e,/z", 8") is found. This completes the first 
iteration of the loop; but notice that we have lost the original program: while 1 do e 
is different than while (a, 1) := ((a, 1) + 1); 1 do e. 

To fix this error, we developed the rule below by using a continuation instead 
of the three rules: 
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(ei,//,£) -» {eU^} 

(while e x do e 2 ,/*,<5) — > 

(( Az.if x then 

e 2 ; while ei do e 2 
else 
unit 
)e', ,/,S') 



In this rule, the A abstraction is a continuation. We simplify the rule by 
/? — reducing the application of the continuation to e\ and arrive at the rule below. 



(ei ,M,f) 

(while ei do e 2 , /*, 5) — > (if e[ then e 2 ; while e a do e 2 else unit ,yu', £') 



This is the rule for loop construct in the present system. 

C. CONCLUSION 

Although we have a better handle on the progress of the evaluations of pro- 
grams, we face an increase in the number of transition rules in the system. When 
we want to add the binary operations to the language, the number of rules increases 
greatly. One possible effect of this is that proofs might be complicated and unneces- 
sarily long. 
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V. 



CONCLUSIONS AND FUTURE WORK 



A. CONCLUSIONS 

1. Type Inference Algorithm 

We have presented an ML-style type inference algorithm called W c based on 
Milner’s algorithm W [Mil78] [DaM82]. An implementation of W c has been given in 
Appendix as part of an interpreter of PolyC. We expect a correctness proof of W c be 
straightforward but it is beyond the scope of this thesis. 

2. The Transition Semantics 

An imperative programming language with first class pointers should have 
a stronger property of type soundness than the subject reduction property; i.e., if 
a closed term has type r, then the evaluation of that term yields a value of type 
r if evaluation terminates successfully. For this reason, Smith and Volpano prove 
soundness of the PolyC type system by formulating the evaluation rules of PolyC’s 
natural semantics as an instance of a recursive function called eval [SmV96a]. But 
this proof seems to be slightly informal. To establish a basis for a more formal proof, 
we developed a transition semantics for PolyC and have presented it in this thesis. 
We believe that a transition semantics exposes more information about the course of 
an evaluation, thus making it possible to give more rigorous soundness arguments. 
But a transition semantics tends to introduce a large number of rules in the system, 
which makes proofs more cumbersome. 

B. FUTURE WORK 

1. Formal Soundness Proof 

Volpano and Smith are currently working on a new soundness proof with 
respect to natural semantics using partial evaluation trees. Pfenning is also expected 
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to give a soundness proof 1 using the Elf programming language, which is based on the 
linear logical framework concept [Pfe96]. We believe a soundness proof of the PolyC 
type system is possible using the transition semantics given in this thesis as well. 

2. Extending PolyC 

Extending PolyC with integer and boolean operations is a trivial task, and 
they have already been included in the interpreter implementation given in Appendix. 
Polymorphic records and variants, on the other hand, require modifications to the 
type system and to the type inference algorithm. Ohori [Ohor95] investigates an 
ML-style polymorphic record calculus in a functional setting by introducing kinded 
quantification , which places restrictions on possible instantiations of type variables. 
His work is an appealing foundation for labeled records and variants in the PolyC 
language. 



1 Based on the personal communication during ESOP’96, Linkoping Sweden 
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APPENDIX. SOURCE PROGRAM FOR THE 

INTERPRETER 



1. REMARKS 

Developing a type inference algorithm has led to an implementation of W c to 
see how it works in practice. Besides type inference we also implemented the natural 
semantics of Poly C given in [SmV 96 a] and, as a result, we have created an interpreter 
for PolyC. During implementation we tried not to go beyond the PolyC calculus and 
we accomplished this except for SSL lists used in the representation of formal and 
actual parameters. 

Annotations throughout the source code are kept concise by assuming that 
the reader will have some knowledge about programming language theory and some 
experience with functional programming. 



2. SSL CODE FOR THE INTERPRETER 



/ 5tc^c^cif:5|c^:*^c^c^:5tc5tc^:5tc^c*5*c + ^c*5f:^c5(c^c5|<3tc^:^:5f:5tc5tc^c5(c^3tc3f:5t:^:5|c^:5*c5jc5tc5f:^c5te3f:***^c5|c** ******** ****** 



This interpreter is written using Synthesizer Generator 
Release 4.2. The code given below is the complete code that 
we have used to generate the interpreter by using the Makefile 
given also below. For space efficiency, we put all the files 
together in this appendix, but each file is clearly 
identifiable by the header provided before the beginning of a . 
file. The textual appearance order of files in this appendix is 
alphabetical except Makefile which is given last. Following are 
the files: 



assign . ssl 
assign_inf er . ssl 
bool . ssl 
bool_inf er . ssl 
eval . ssl 
explist . ssl 
id. ssl 
if . ssl 



infer . ssl 
int . ssl 
int_inf er . ssl 
lambda . ssl 
lambda_inf er . ssl 
let . ssl 
let_inf er .ssl 
letarr . ssl 



lex . ssl 
pair . ssl 
pair_inf er . ssl 
real . ssl 
real_inf er . ssl 
while. ssl 
while_inf er . ssl 
Makef ile 



* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 
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* if_infer.ssl letarr_inf er . ssl * 

* * 

* Naming of files are intended to be informative what is in there; * 

* for instance bool. ssl gives the required definitions like * 

* abstract syntax, minimal paranthesization, unparsing rules, * 

* template commands and concrete input syntax of boolean * 

* operations. Type inference for these operations (constructs) is * 

* in bool.inf er . ssl . * 

* * 

* It should be noted one more time that this interpeter extends * 

* Poly C [SmV96] with real type and integer and bool operations. * 

* * 



*******************************************************************/ 






* File Name : assign. ssl * 

* Purpose : Definitions for Compose, Assign, AddrOf , Deref , * 

* Unit, Dead, Uninit, InvalidAddr constructors of * 

* exp phylum. * 



************************************** ****************************/ 

/* InvalidAddr is returned as a result of a memory lookup */ 

/* Abstract syntax */ 

exp : Compose (exp exp) 

I Assign (exp exp) 

I AddrOf (exp) 

I Deref (exp) 

I Unit() 

I Dead, Uninit, InvalidAddr () 



/* Minimal parenthesization 
exp : Compose PP2(0) 

I Assign PP2(0) 

I AddrOf PP1(0) 

| Deref PP1(0) 



*/ 
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/* Unparsing 



*/ 



/* 



* In [SmV96] , * is used for dereferencing. But in this 

* implementation we use ! for dereferencing and * for integer 

* multiplication. 

*/ 



exp 





Compose 


[ “ 






Assign 


[ * 






AddrOf 


[ * 






Deref 


[ “ 






Unit 


[ “ 






Dead 


[ ' 






Uninit 


[ ~ 






InvalidAddr 


[ “ 





<3 ‘/.n" <3 ] 

<3 " %S (PUNCTUATION : := # /,S) " <3 ] 
'7.S (OPERATOR :&'/„S)” <3 ] 

"’/„S (OPERATOR: !'/„S)" (3 ] 

"%S (KEYWORD : unites) " ] 

'7.S (KEYWORD :dead°/.S)" ] 

’7.S (KEYWORD :uninit°/„S)" ] 

’7.S (KEYWORD : invalid/'s) ‘/.S 
(KEYWORD: addresses) " ] 



/* Template commands */ 

transform exp 

on <exp>: Compose (<exp> , <exp>), 

on "e;<exp>" e when (e != <exp>) : Compose(e, <exp>) , 

on "<exp>;e" e when (e != <exp>) : Compose(<exp>, e) , 

on <exp> : Assign(<exp> , <exp>) , 

on <exp> : AddrOf (<exp>) , 

on "!" <exp>: Deref (<exp>) , 

on "!" e when (e != <exp>) : Deref (e) 



/* Concrete input syntax */ 

Exp ::= (Exp ASSIGN Exp) {$$.abs = Assign (Exp$2. abs, Exp$3.abs);} 

I (Exp Exp) -($$.abs = Compose (Exp$2.abs, Exp$3.abs);} 

I (’!' Exp) {Exp$l.abs = Deref (Exp$2 . abs) ; } 

I (’&’ Exp) {$$.abs = AddrOf (Exp$2. abs) ;} 

I (UNIT) {Exp. abs = Unit;> 



* File Name : assign_infer . ssl * 
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* Purpose : Type inference for the cons ’tors given in assign. ssl * 

exp : Unit { 

exp .typeAssignment = UnitType; 

exp . S = exp . s ; 

exp. partial = false; 

> 

I Dead { 

exp .typeAssignment = NullType; 
exp.S = FailSubst; 
exp. partial = false; 

> 

I Uninit { 

exp .typeAssignment = UniversalType; 

exp . S = exp . s ; 

exp. partial = false; 

> 

I InvalidAddr { 

exp . typeAssignment = UniversalType; 

exp . S = exp . s ; 

exp. partial = false; 

> 

I Deref { 

local TYPEVAR beta; 
beta = WeakVar(newsymi() ) ; 
exp$2 .typeEnv = exp$l .typeEnv; 
exp$2 . letvars = exp$l . letvars ; 
exp$2.s = exp$l.s; 

exp$l.S = Unify (Ref Type (TypeVar (beta) ) , 

exp$2 .typeAssignment , exp$2.S); 
exp$l .typeAssignment= ApplySubstToTypeExp(exp$l .S, TypeVar( 

beta) ) ; 

exp$l .partial = exp$2 .partial ; 
exp$2.sv = exp$l.sv; 
exp$2.encl = exp$l.encl; 
exp$2.top = exp$l.top; 

> 

I Assign { 

exp$2 .typeEnv = exp$l .typeEnv; 
exp$2 . letvars = exp$l . letvars ; 
exp$2.s = exp$l.s; 

exp$3. typeEnv = ApplySubstToTypeEnv(exp$2 . S , exp$l .typeEnv); 
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exp$3 . letvars = exp$l . letvars ; 
exp$3 . s = 



with(exp$2) ( 



I dent (Identif ier(i)) : exp$2.S, 



Deref (e) 



: exp$2.S, 
: exp$2.S, 



Subscript (*,*) : 

VoidExpO 

default : FailSubst 



: exp$2.S, 



); 



exp$l .typeAssignment = 

ApplySubstToTypeExp(exp$l .S, exp$2 .typeAssignment) ; 
exp$l.S = 

with(exp$2) ( 

Ident (Identif ier(i)) : 

InLVList (Identif ier(i) , exp$l . letvars) ? 

Unify (Inst Scheme (LookupInTypeEnv (i , 

exp$l . typeEnv)) , exp$3 .typeAssignment ,exp$3 . S) 

: FailSubst, /* not a letvar id */ 

VoidExpO : 

Unify (exp$2 . typeAssignment , exp$3 . typeAssignment , 
exp$3 . S) , 

Deref (e) : 

Unif y (exp$2 . typeAssignment , exp$3 . typeAssignment , 
exp$3 . S) , 

Subscript (*, *) : 

Unif y (exp$2 .typeAssignment , exp$3 .typeAssignment , 
exp$3 . S) , 

default : FailSubst 



exp$l .partial = exp$2 .partial II exp$3. partial; 

exp$3.sv = exp$l.sv; 

exp$2.sv = exp$l.sv; 

exp$3 . end = exp$ 1 . end ; 

exp$2.encl = exp$l.encl; 

exp$2.top = false; 

exp$3.top = exp$l.top; 

> 

I AddrOf { 

local TYPEEXP tau; 

exp$2 .typeEnv = exp$l .typeEnv; 

exp$2. letvars = exp$l . letvars ; 



); 
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exp$2.s = exp$l.s; 
exp$l . S = 

with(exp$2) ( 

Ident (Identif ier(i) ) : 

InLVList (Identif ier(i) , exp$l .letvars) ? 

Unify (TypeVar(WeakVar(newsymi()) ) , tau, exp$l . s) 
: FailSubst, / * not a letvar id */ 

VoidExpO : exp$2.S, 

Deref(*) : exp$2.S, 

Subscript (*, *) : exp$2.S, 

default : FailSubst 

); 

exp$l .typeAssignment = RefType(tau) ; 
exp$l .partial = exp$2. partial; 

tau = 

with(exp$2) ( 

Ident (Identif ier(i) ) : 

InstScheme(LookupInTypeEnv(i ,exp$l .typeEnv) ) , 
VoidExpO '• TypeVar(WeakVar(newsymi() ) ) , 
Deref(*) : exp$2 . typeAssignment , 

Subscript (*, *) : exp$2 .typeAssignment , 
default : NullType 

); 

exp$2.sv = exp$l.sv; 
exp$2.encl = exp$l.encl; 
exp$2.top = exp$l.top; 

} 

Compose ■{ 

exp$2 .typeEnv = exp$l .typeEnv; 
exp$2 . letvars = exp$l .letvars; 
exp$2 . s = exp$l . s ; 
exp$3 . s = exp$2.S; 
exp$3 . letvars = exp$l .letvars; 
exp$3 .typeEnv = ApplySubstToTypeEnv(exp$2 .S, 
exp$l .typeEnv) ; 
exp$l.S = exp$3.S; 

exp$l .typeAssignment = exp$3 . typeAssignment ; 
exp$l .partial = exp$2 .partial II exp$3. partial; 
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exp$3.sv = exp$l.sv; 
exp$2.sv = exp$l.sv; 
exp$3.encl = exp$l.encl; 
exp$2.encl = exp$l.encl; 
exp$2.top = false; 
exp$3.top = expSl.top; 

} 



exp : Deref {in TypeErrors on (exp$l.S == FailSnbst && 

exp$2 . S != FailSubst);} [ TypeErrors <§ : "Deref'/.n"" ] 

I Assign {in TypeErrors on (expSl.S == FailSubst && 

exp$2.S != FailSubst && exp$3.S != FailSubst);} 

[ TypeErrors 0 : "Assignin''" ] 

I AddrOf {in TypeErrors on (exp$l.S == FailSubst && 

exp$2.S != FailSubst);} [ TypeErrors @ : "AddrOf‘/.n"~ ] 



* File Name : bool.ssl * 

* Purpose : Boolean operations. * 

/* Abstract syntax */ 

exp : Not (exp) 

I And, Or, Equal, NotEqual(exp exp) 



/* Minimal parenthesization */ 

exp : Not PP1(9) 

I And PP2 (3) 

I Or PP2 (2) 

I Equal PP2(4) 

I NotEqual PP2(4) 



/* Unparsing */ 

exp : Not [~ : := "*/ 0 S (PUNCTUATION : " lp M, /.S (OPERATOR : */<not>'/ 0 S) " <§ 

"%S (PUNCTUATION : " rp '7.S)"] 
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I And [~ ::= "*/ t S (PUNCTUATION : " lp "’/.S)" 0 " °/.S (OPERATOR :&&'/.S) " 
@ "%S( PUNCTUATION:" rp "°/.S)"] 

I Or [“ ::= "’/.S (PUNCTUATION: " lp "'/.S)" @ " */.S (OPERATOR : I |°/,S) " 
O " 4 /.S (PUNCTUATION:" rp M, /.S)"] 

I Equal [~ ::= "%S (PUNCTUATION: " lp ,,# /„S)" @ " %S ( OPERATOR : =7,S ) " 
« ’7.S (PUNCTUATION:" rp "*/.S)"] 

I NotEqual [~ ::= "*/.S (PUNCTUATION : " lp "‘/.S)" 0 " %S(OPERATOR: 
%<ne>*/.S) " @ " # /„S (PUNCTUATION:" rp "°/.S)"] 



/* Template commands */ 

transform exp 

on """ <exp> : Not(<exp>), 
on "&&" <exp> : And(<exp>, <exp>) , 
on "II" <exp> : Or(<exp>, <exp>) , 
on "=" <exp> : Equal (<exp>, <exp>) , 
on "<>" <exp> : NotEqual (<exp> , <exp>) 



/* Concrete input syntax */ 

Exp : := (>~> Exp) { Exp$l.abs = Not (Exp$2 . abs) ; } 

I (Exp LOGICALAND Exp) 

{ Exp$l.abs = And(Exp$2 .abs , Exp$3.abs); } 

I (Exp LOGICALOR Exp) 

{ Exp$l.abs = 0r(Exp$2 . abs , Exp$3.abs); } 

I (Exp ’=’ Exp prec '=') 

■( Exp$l.abs = Equal (Exp$2 . abs , Exp$3.abs); } 

I (Exp NOTEQUAL Exp prec NOTEQUAL) 

{ Exp$l.abs = NotEqual (Exp$2. abs, Exp$3.abs); } 



* File Name : bool_inf er . ssl * 

* Purpose : Type inference for the cons 'tors given in bool. ssl * 

exp : Not { 

exp$2 . typeEnv = exp$l . typeEnv; 
exp$2 . letvars = exp$l . letvars ; 
exp$2 . s = exp$l . s ; 
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exp$l.S = Unify (exp$2 . typeAssignment , 

IntType, exp$2.S); 
exp$l .typeAssignment = IntType; 
exp$l .partial = exp$2 . partial ; 
exp$2.sv = exp$l.sv; 
exp$2.encl = exp$l.encl; 
exp$2.top = exp$l.top; 

> 

I And, Or { 

exp$2 . typeEnv = exp$l .typeEnv ; 
exp$2 . letvars = exp$l . letvars ; 
exp$3 . letvars = exp$l .letvars; 
exp$2.s = expSl.s; 

exp$3.s = Unify (exp$2 .typeAssignment , 

IntType, exp$2.S); 

exp$3 .typeEnv = ApplySubstToTypeEnv(exp$3.s, 
exp$l .typeEnv) ; 

exp$l.S = Unify(exp$3. typeAssignment, 

IntType, exp$3.S); 
exp$l . typeAssignment = IntType; 
exp$l .partial = exp$2 .partial II exp$3 .partial ; 
exp$3.sv = exp$l.sv; 
exp$2.sv = exp$l.sv; 
exp$3.encl = exp$l.encl; 
exp$2.encl = expSl.encl; 
exp$2.top = false; 
exp$3.top = exp$l.top; 

> 

I Equal, NotEqual { 

exp$2 .typeEnv = exp$l .typeEnv ; 
exp$2 .letvars = exp$l .letvars ; 
exp$3 . letvars = exp$l . letvars ; 
exp$2.s = exp$l.s; 
exp$3.s = exp$2.S; 

exp$3 .typeEnv = ApplySubstToTypeEnv (exp$2 . S , exp$l .typeEnv) ; 
exp$l.S = Unify(exp$2 .typeAssignment , exp$3 .typeAssignment , 
exp$3 . S) ; 

exp$l .typeAssignment = IntType; 

exp$l .partial = exp$2 .partial II exp$3 .partial ; 
exp$3.sv = exp$l.sv; 
exp$2.sv = exp$l.sv; 
exp$3.encl = exp$l.encl; 
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exp$2.encl = exp $1. end; 
exp$2.top = false; 
exp$3.top = exp$l.top; 

> 



exp : Not {in TypeErrors on (exp$l.S == FailSubst kk 

exp$2.S != FailSubst); } [ TypeErrors @ : "Noty o n" ~ ] 

I And, Or {in TypeErrors on (exp$l.S == FailSubst kk 

exp$2.S != FailSubst kk exp$3.S != FailSubst);} 

| And [ TypeErrors @ : "And*/,n" ] 

I Or [ TypeErrors @ : "Ory,n" “ “ ] 

I Equal, NotEqual {in TypeErrors on (exp$l.S == FailSubst kk 

exp$2.S != FailSubst kk exp$3.S != FailSubst);} 
I Equal [ TypeErrors @ : " Equal'/, n" ] 

I NotEqual [ TypeErrors @ : "NotEqual'/.n" ] 






* File Name : eval.ssl * 

* Purpose : Implements the natural semantics (structured * 

* operational semantics) of Poly C wrt the rules * 

* given in [SmV96] . User has the option to evaluate * 

* a program or not by clicking on the button labeled * 

* eval-on. * 

* When the evaluation of a program gets stuck due * 

* to one of four error cases described in [SmV96] * 

* the interpreter returns the partially evaluated * 

* program as a result for debugging purposes . * 



MEMORY : NullMemO [fl : ] 

I MemConcat (LOCATION exp MEMORY) { 

INHSILENCE (exp) 

} [® : "*/.{[" @ " \<rightarrow>" <§ "] , /o" fi "'/,}"] 



/* Result of an evaluation */ 
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EVAL : EvalPair (exp MEMORY) { 

INHSILENCE(exp) 

> C" : '7.S (PUNCTUATION : ('/,S)" Q "'/.S (PUNCTUATION : ,'/„S) %o" @ 

"’/.S (PUNCTUATION O’/.S)" ] 



/* 

* We have two different array subscript constructors : one returns 

* a value as a result of the evaluation (r-value) and the other 

* returns a Varloc (1-value) . Having these two constructors is 

* an efficient way of implementing these two different occurrences. 

* Otherwise, if we had only one constructor that returns Varloc 

* then the result of the evaluation of an expression occuring 

* in r-value context must be checked if the result is a Varloc which 

* must be dereferenced with an extra step. 

*/ 

/* We add basic logical operations to the language. They 

* implement the same C semantics as one would expect. 

* False is denoted by 0 and True is denoted by a non-zero 

* value; a logical operation constructors returns 1 if the 

* result of the operation is True. 

*/ 

EVAL eval (exp e, MEMORY mu) { 
with (e) ( 

Varloc(l) : 

EvalPair (MemoryLookUp (1 , mu), mu), 

Sum(el , e2) : 

let EvalPair(vl, mul) = eval (el, mu) in ( 

let EvalPair (v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

IntOp(il) : with (v2) ( 

Int0p(i2) : EvalPair(IntOp(il + i2) , mu2) , 
default : EvalPair (Sum(vl , v2) , mu) 

), 

default: EvalPair (Sum(vl ,e2) , mu) 

))), 

PtrAdd(el ,e2) : 

let EvalPair (vl, mul) = eval (el, mu) in ( 

let EvalPair (v2, mu2) = eval(e2, mul) in ( 
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with (vl) ( 

Ref loc(Loc(s ,o) ) : with (v2) ( 

IntOp(i) : EvalPair(Ref loc(Loc(s , INTtoSTR( 
STRtoINT(o) + i))), mu2) , 
default : EvalPair(PtrAdd(vl ,v2) ,mu) 

), 

default: EvalPair (PtrAdd(vl , e2) , mu) 

))), 

Subscript (el , e2) : 

let EvalPair (vl, mul) = eval(el, mu) in ( 

let EvalPair (v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

Ref loc(Loc(s ,o) ) : 
with (v2) ( 

IntOp(i) : 

EvalPair (MemoryLookUp(Loc (s , INTtoSTR( 
STRtoINT(o) + i)) , mu2) , mu2) , 
default : EvalPair (Subscript (vl , v2) ,mu) 

), 

default : EvalPair (Subscript (vl ,e2) , mu) 

))), 

SubscriptL(el, e2) : 

let EvalPair (vl, mul) = eval(el, mu) in ( 

let EvalPair(v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

Refloc(Loc(s,o)) : with (v2) ( 

IntOp(i) : EvalPair(Varloc(Loc(s,INTtoSTR( 
STRtoINT(o)+i))), mu2), 
default : EvalPair (SubscriptL(vl , v2) , mu) 

), 

default : EvalPair (SubscriptL(vl , e2) , mu) 

))), 

Diff (el , e2) : 

let EvalPair (vl, mul) = eval(el, mu) in ( 

let EvalPair (v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

IntOp(il): with (v2) ( 

Int0p(i2): EvalPair (IntOp(il - i2) , mu2) , 
default: EvalPair (Diff (vl, v2) , mu) 

), 

default: EvalPair (Diff (vl , e2) , mu) 
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))), 

Prod(el , e2) : 

let EvalPair (vl , mul) = eval(el, mu) in ( 

let EvalPair (v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

IntOp(il) : with (v2) ( 

IntOp ( i2 ) : EvalPair(IntOp(il * i2) , mu2) , 
default: EvalPair(Prod(vl , v2), mu) 

), 

default: EvalPair (Prod(vl , e2) , mu) 

))), 

LessThan(el, e2) : 

let EvalPair (vl, mul) = eval(el, mu) in ( 

let EvalPair(v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

IntOp(il) : with (v2) ( 

Int0p(i2) : EvalPair(IntOp( (il < i2) ? 1 
: 0) , mu2) , 

default: EvalPair(LessThan(vl , v2) , mu) 

), 

default: EvalPair (LessThan(vl , e2) , mu) 

))), 

LessThanOrEqual (el , e2) : 

let EvalPair (vl, mul) = eval(el, mu) in ( 

let EvalPair(v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

IntOp(il) : with (v2) ( 

Int0p(i2) : EvalPair (IntOp( (il <= i2) ? 1: 0), 
mu2) , 

default: EvalPair(LessThanOrEqual(vl, v2) , mu 

), 

default: EvalPair (LessThanOrEqual (vl , e2) , mu) 

))), 

GreaterThan(el , e2) : 

let EvalPair (vl, mul) = eval(el, mu) in ( 

let EvalPair (v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

IntOp(il) : with (v2) ( 

Int0p(i2) : EvalPair(IntOp((il > i2)? 1:0), 
mu2) , 

default: EvalPair (GreaterThan(vl , v2), mu) 

), 
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default: EvalPair (GreaterThan(vl , e2) , mu) 

))), 

GreaterThanOrEqual(el, e2) : 

let EvalPair (vl, mul) = eval(el, mu) in ( 

let EvalPair(v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

IntOp(il) : with (v2) ( 

Int0p(i2): EvalPair(IntOp((il >= i2) ? 1: 0), 
mu2) , 

default: EvalPair(GreaterThanOrEqual(vl , v2) , 
mu) 

), 

default: EvalPair (GreaterThanOrEqual (vl , e2) , mu) 

))), 

Quot (el , e2) : 

let EvalPair(vl, mul) = eval(el, mu) in ( 

let EvalPair (v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

IntOp(il): with (v2) ( 

Int0p(i2) : (i2 == 0) ? EvalPair(Quot (vl , v2) ,mu) 
: EvalPair(IntOp(il / i2) , mu2) , 
default: EvalPair(Quot(vl, v2) , mu) 

), 

default: EvalPair (Quot (vl , e2) , mu) 

))), 

Not(e): let EvalPair(v, mul) = eval(e, mu) in ( 
with (v) ( 

IntOp(b): EvalPair (Int0p((b == 0) ? 1: 0) , mul), 
default: EvalPair (Not (v) , mu) 

)), 

And (el , e2) : 

let EvalPair(vl, mul) = eval(el, mu) in ( 

let EvalPair(v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

IntOp(bl) : with (v2) ( 

IntOp (b2) : EvalPair(IntDp( ( (bl != 0) && 

(b2 != 0)) ? 1: 0) , mu2) , 
default: EvalPair (And (vl , v2) , mu) 

), 

default: EvalPair (And(vl , e2) , mu) 

))), 

Or (el , e2) : 
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let EvalPair(vl , mul) = eval(el, mu) in ( 

let EvalPair(v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

IntOp(bl) : with (v2) ( 

Int0p(b2): EvalPair(IntOp(((bl != 0) II 
(b2 != 0)) ? 1: 0) , mu2) , 
default: EvalPair (Or(vl , v2) , mu) 

), 

default: EvalPair (Or (vl , e2) , mu) 

))), 

Equal (el, e2) : 

let EvalPair (vl, mul) = eval(el, mu) in ( 

let EvalPair (v2, mu2) = eval(e2, mul) in ( 

Value(vl) ? Value(v2) ? EvalPair(IntOp( (vl == v2) ? 1 

: 0) , mu2) 

: EvalPair (Equal (vl , v2) , mu) 

: EvalPair (Equal (vl , e2) , mu) 

)), 

NotEqual(el, e2) : 

let EvalPair(vl, mul) = eval(el, mu) in ( 

let EvalPair(v2, mu2) = eval(e2, mul) in ( 

Value (vl) ? Value(v2) ? EvalPair (IntOp( (vl != v2) ? 1 

: 0) , mu2) 

: EvalPair (NotEqual(vl , v2) , mu) 
: EvalPair (NotEqual(vl , e2) , mu) 

)), 

Deref (el) : 

let EvalPair(vl, mul) = eval(el, mu) in ( 
with (vl) ( 

Refloc(l) : EvalPair (MemoryLookUp (1 , mul), mul), 
default: EvalPair (Deref (vl) , mu) 

)), 

Call(el ,al) : 

let EvalPair(vl, mul) = eval(el, mu) in ( 
let EvalPair (v2, mu2) = EvalList(al, mul, 

ActualParamListNilO) in ( 

with(vl) ( 

Lambda(x, e2) : with(v2)( 

Call(Unit, a2) : eval(ReplaceWithActuals( 
a2 , x, e2) , mu2) , 

Call (Dead, a2) : EvalPair(Call(vl , a2) , mu2) , 
default: EvalPair (Call (vl , 
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v2: : ActualParamListNil) ,mu) 

/* never happens */ 

), 

default: EvalPair(Call (vl , al), mu) 

))), 

Assign(el , e2) : 
with(el) ( 

Deref (el) : 

let EvalPair(vl, mul) = eval(el, mu) in ( 

let EvalPair(v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

Refloc(l): with (MemoryLookUp (1 , mu2)) ( 

Dead: EvalPair (Assign(Deref (Dead) , e2) , 
mu) , 

default: Value(v2) ? 

EvalPair (v2, UpdateMemory(l , v2, mu2)) 

: EvalPair(Assign(Varloc(l) , v2) , mu) 

), 

default :EvalPair(Assign(Deref (vl) , e2) , mu) 

))), 

Subscript (e3, e4) : 

let EvalPair(vl, mul) = 

eval(SubscriptL(e3,e4) , mu) in ( 
let EvalPair (v2, mu2) = eval(e2, mul) in ( 
with (vl) ( 

Varloc(l) : Value(v2) ? EvalPair(v2, 

UpdateMemory(l, v2, mu2)) 

: EvalPair(Assign(vl ,v2) , mu), 
default : EvalPair(Assign(vl , e2) , mu) 

))), 

Varloc(l) : 

let EvalPair(v, mul) = eval(e2, mu) in ( 

Value(v) ? EvalPair(v, UpdateMemory (1, v, mul)) 

: EvalPair(Assign(el , v) , mu)), 
default: EvalPair(e, mu) 



), 

AddrOf (el) : 
with(el) ( 

Deref (e2) : 

let EvalPair (vl, mul) = eval(e2, mu) in ( 
with (vl) ( 

Refloc(l): EvalPair(vl, mul). 
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default : EvalPair (AddrOf (Deref (vl)) , mu) 

) 

), 

Subscript (e2 , e3) : 

let EvalPair(vl, mul) = eval(SubscriptL(e2, e3),mu) in ( 
with (vl) ( 

Varloc(l): EvalPair(Refloc(l) , mul), 
default : EvalPair (AddrOf (vl) , mu) 

) 

), 

Varloc(l) : EvalPair (Ref loc(l) , mu), 
default : EvalPair (e, mu) 

), 

Compose(el, e2) : 

let EvalPair (v, mul) = eval(el, mu) in ( 

Value(v) ? eval(e2, mul): EvalPair (Compose (v , e2) , mu) 

), 

While(el, e2) : 

let EvalPair(vl, mul) = eval(el, mu) in ( 
with (vl) ( 

IntOp(n) : (n ! = 0) ? 

let EvalPair(v2, mu2) = eval(e2, mul) in ( 
Value (v2) ? eval(e, mu2) 

: EvalPair (While (vl , v2) , mu)) 

: EvalPair(Unit , mul), 
default: EvalPair (While (vl , e2) , mu) 

)), 

Cond(el , e2 , e3) : 

let EvalPair (vl, mul) = eval(el, mu) in ( 
with (vl) ( 

IntOp (n) : eval((n != 0) ? e2: e3, mul), 
default: eval(Cond(vl, e2, e3) , mu) 

)), 

LetVar(x, el, e2) : 

let EvalPair (vl, mul) = eval(el, mu) in ( 

Value(vl) ? 

let 1 = (newsymiO) [2 :] in ( 
let EvalPair (v2, mu2) = 

eval (ReplaceIn(Varloc (Loc(l , INTtoSTR(O) ) ) , x, e2) , 
UpdateMemory(Loc(l , INTtoSTR(O) ) , vl, mul)) in ( 
Value(v2) ? EvalPair(v2, UpdateMemory(Loc(l, 
INTtoSTR(O) ) , Dead, mu2)): EvalPair (v2, mu))) 
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: EvalPair(LetVar (x, vl, e2) , mu)), 

Let(x, el, e2) : 

let EvalPair(vl, mul) = eval(el, mu) in ( 

Value(vl) ? eval(ReplaceIn(vl, x, e2) , mul) 

: EvalPair (Let (x, vl, e2) , mu) 

), 

LetArr(x, el , e2) : 

let EvalPair(vl, mul) = eval(el, mu) in ( 
with(vl) ( 



IntOp(n) : (n > 0) ? 

let EvalPair(v2, mu2) = InitializeArray(n, mul) in ( 
let EvalPair(v3, mu3) = eval (Replaceln(v2 , x, e2) , 

mu2) in ( 

Value(v3) ? EvalPair (v3,MarkDead(n, v2, mu3)) 

: EvalPair (v3, mu2) 

)) 

: EvalPair(LetArr(x, vl, e2) , mu), /* n <= 0*/ 
default: EvalPair (Let Arr(x, vl, e2), mu) 

)), 

Pair(el , e2) : 

let EvalPair(vl, mul) = eval(el, mu) in ( 

Value(vl) ? let EvalPair(v2, mu2) = eval(e2, mul) in ( 
Value(v2) ? EvalPair (Pair(vl , v2) , mu2) 

: EvalPair (Pair (vl , v2) , mu) 

) 

: EvalPair (e, mu) 



), 

default: EvalPair(e, mu) 

) 



h 



/* Is the expression 
BOOL Value (exp e) { 
with(e) ( 

Lambda(* , *) : 
Int0p(*) : 
Real0p(*) : 
Refloc(*) : 
Ident(*) : 
Unit 

default : 



e a syntactic value? 



true , 
true, 
true , 
true, 
true, 
true, 
false 



*/ 



) 



58 



>; 

/* Replace all free occurrences of formal parameters given by 
* f in e with the actual parameters given by a. 

*/ 

exp ReplaceWithActuals (actualParamList a, f ormalParamList f, exp e) { 
with(a) ( 

ActualParamListPair (vl , restl) : 
with(f) ( 

FormalParamListPair(x, rest2) : 

Replaceln(vl , x, ReplaceWithActuals (restl , rest2, e) ) , 
default : e 

), 

default : e 

) 

>; 

/* [v/x]e -- replace all free occurrences of x in e by v */ 

exp Replaceln (exp v, Id x, exp e) { 
with (x) ( 

IdNullO : e, 

Identif ier(y) : ReplaceAux(v, y, e) 

) 

>; 

exp ReplaceAux (exp v, ID id, exp e) { 
with (e) ( 

Ident (Identif ier(x) ) : (id == x) ? v: e, 

AddrOf(el): AddrOf (ReplaceAux(v, id, el)), 

Assign(el , e2) : Assign (ReplaceAux (v, id, el) , ReplaceAux (v, id 

,e2)), 

Deref(el): Deref (ReplaceAux (v, id, el)), 

Compose(el, e2) : Compose(ReplaceAux(v , id, el), ReplaceAux(v , 
id,e2) ) , 

Lambda(f, el): IsFormalParameter (id, f) ? e 

: Lambda(f, ReplaceAux(v, id, el)), 

While(el, e2) : While(ReplaceAux(v, id, el) ,ReplaceAux(v , id, e2) 

), 

Let (Identif ier(x) , el, e2) : 

(id == x) ? Let (Identif ier(x) , ReplaceAux(v, id, el), e2) 

: Let (Identif ier(x) , ReplaceAux(v, id, el), 
ReplaceAux(v, id, e2)), 
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LetVar(ldentif ier (x) , el, e2) : 

(id == x) ? LetVar(Identif ier(x) , ReplaceAux(v , id, el), e2) 

: LetVar (Identifier (x) , FteplaceAux(v, id, el), 
ReplaceAux(v, id, e2)), 

LetArr (Identif ier(x) , el, e2) : 

(id == x) ? LetVar (Identif ier(x) , ReplaceAux(v, id, el), 

e2) 

: LetArr(Identif ier(x) , ReplaceAux(v, id, el), 

ReplaceAux(v, id, e2)), 
PtrAdd(el, e2) : PtrAdd(ReplaceAux(v , id, el), ReplaceAux(v, id, 
e2) ) , 

Subscript(el, e2) : Subscript (ReplaceAnx(v, id, el), ReplaceAux( 

v, id, e2) ) , 

SubscriptL(el , e2) : SubscriptL(ReplaceAux(v , id, el) ,ReplaceAux( 

v, id, e2) ) , 

Pair (el, e2) : Pair (ReplaceAux(v, id, el), ReplaceAux(v, id, e2) 

), 

Sum(el, e2) : Sum(ReplaceAux(v , id, el), ReplaceAux(v, id, e2)), 
Diff(el, e2) : Diff (ReplaceAux(v, id, el), ReplaceAux(v , id, e2 
)), 

Prod(el, e2) : Prod(ReplaceAux(v, id, el), ReplaceAux(v , id, e2) 

), 

Quot(el, e2) : Quot (ReplaceAux(v, id, el), ReplaceAux(v , id, e2) 

), 

LessThan(el , e2) : 

LessThan(ReplaceAux(v, id, el), ReplaceAux(v, id, e2) ) , 
LessThanOrEqual(el, e2) : 

LessThanOrEqual(ReplaceAux(v, id, el), ReplaceAux(v, id, e2)). 
Great erThan (e 1 , e2) : 

GreaterTh.an(ReplaceAux(v, id, el), ReplaceAux(v, id, e2)), 
GreaterThanOrEqual(el , e2) : 

GreaterTh.anOrEqual(ReplaceAux(v, id, el), ReplaceAux(v , id, e2) 

), 

Not(e): Not(ReplaceAux(v, id, e)), 

And(el, e2) : And(ReplaceAux(v, id, el), ReplaceAux(v , id, e2)), 
Or (el, e2) : Or (ReplaceAux(v , id, el), ReplaceAux(v , id, e2)), 
Equal(el, e2) : Equal (ReplaceAux(v, id, el), ReplaceAux(v, id, e2) 
), 

NotEqual(el, e2) : NotEqual(ReplaceAux(v, id, el), 

ReplaceAux(v , id, e2)), 

Cond(el, e2 , e3) : Cond( ReplaceAux(v , id, el), ReplaceAux(v, id, 

e2) , ReplaceAux(v, id, e3) ) , 
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>; 



Call(el, 1): Call(ReplaceAux(v, id, el), ReplacelnList (v, id,l) 

), 

default : e 



/* Does id occur in formal parameter list x ? */ 

BOOL IsFormalParameter (ID id, f ormalParamList x) { 
with (x) ( 

FormalParamListPair(Identif ier(v) , rest) : 

(id == v) ? true: IsFormalParameter (id, rest), 
default : false 

) 

>; 



/* Replace all free occurrences of id in each element e of 1 */ 
actualParamList ReplacelnList (exp v, ID id, actualParamList 1) { 
with (1) ( 

ActualParamListNil : 1, 

ActualParamListPair(e, rest) : 

ReplaceAux(v, id, e) : : ReplacelnList (v, id, rest), 

) 

>; 



/* We evaluate the actual paramaters 11 in order and put the 

* results into another list 12. We use the constructor Call 

* as a placeholder to return the result since it is the only 

* expression constructor with a actualParamList type of argument. 

* The first argument of Call is used to indicate if the 

* evaluation of 11 is completed successfully. If so, we return 

* Unit as the first argument and 12 as the second argument, 

* otherwise we return Dead as the first argument and a partially 

* evaluated list as the second argument. 

*/ 

EVAL EvalList( actualParamList 11, MEMORY mu, actualParamList 12) { 
with(ll) ( 

ActualParamListPair(e , rest): 

let EvalPair(v, mul) = eval(e, mu) in ( 

Value(v) ? EvalList (rest, mul, v::12) 
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) 



: EvalPair(Call(Dead, ReverseList (ReverseList ( 
rest) 0 v::12)), mul)), 

default: EvalPair (Call (Unit , ReverseList (12) ) , mu) 



>; 

actualParamList ReverseList (actual Par amList 1) •{ 
with(l) ( 

ActualParamListPair(v , rest): ReverseList (rest) @ 

ActualParamListPair(v , ActualParamListNil () ) , 

default : 1 

) 

>; 



/* mu[l:=v] -- update (extend) memory mu with binding l:=v */ 

MEMORY UpdateMemory (LOCATION 1, exp v, MEMORY mu) { 
with (mu) ( 

NullMemO : MemConcat(l, v, mu), 

MemConcat(12, v2, mu2) : (1 == 12) ? MemConcat(l, v, mu2) 

: MemConcat(12, v2, UpdateMemory (1, v, mu2)), 

) 

>; 



exp MemoryLookUp (LOCATION 1, MEMORY mu) { 
with (mu) ( 

MemConcat (12, v2, mu2) : (1 == 12) ? v2: MemoryLookUp(l , mu2) , 
default: InvalidAddr /*Deref erence of a non-existence address */ 

) 

>; 

/* Allocate memory cells for the elements of an array of size n and */ 
/* initialize them to Uninit.*/ 

EVAL Init i al izeArray ( INT n, MEMORY mu) { 
let 1 = (newsymiO) [2:] in ( 

let mul = InitializeArrayAux(n - 1, 1, UpdateMemory(Loc(l, 
INTtoSTR(n-l) ) , Uninit, mu)) in ( 

EvalPair (Ref loc(Loc (1 , INTtoSTR(O) )) , mul) 

)) 
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>; 

MEMORY InitializeArrayAux(lNT n, SEGMENT s, MEMORY mu) { 

(n == 0) ? mu: InitializeArrayAux(n - 1, s, 

UpdateMemory(Loc(s,INTtoSTR(n-l)) , Uninit, mu)) 

>; 



/* Mark the cells allocated for the elements of the array as Dead */ 
MEMORY MarkDead(INT n, exp e, MEMORY mu) { 
with(e) ( 

Refloc(Loc(s,*)) : MarkDeadAux(n , s, mu), 
default : mu /* should never be reached */ 

) 

>; 

MEMORY MarkDeadAux ( INT n, SEGMENT s, MEMORY mu) { 

(n == 0) ? mu: MarkDeadAux (n- 1 , s, 

UpdateMemory(Loc(s,INTtoSTR(n-l) ) , Dead, mu)) 

>; 



* File Name : explist.ssl * 

* Purpose : A program is an explist composed of terms. * 

root expList; 

/* Abstract syntax */ 

term : Static(exp) 

I Dynamic(exp) 

list expList; 

expList : ExpListPair (term expList) 

I ExpListNilQ 



/* Minimal parenthesization */ 

term : Static, Dynamic { exp .precedence = 0; } 
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/* Unparsmg 

expList : ExpListPair [ <3 : 



C ,,0 /oS (PUNCTUATION : ; °/ 0 S) 0 / 9 n°/ 0 n"] O ] 



*/ 



/* Concrete input syntax */ 

ExpList { synthesized expList abs; }; 
expList ~ ExpList.abs; 

ExpList : := (Exp) { ExpList.abs = Static (Exp .abs) :: ExpListNilO ; } 
I (Exp ExpList) {ExpList$l . abs = 

Static (Exp . abs) :: ExpList$2 . abs ; } 



* File Name : id.ssl * 

* Purpose : Defines identifiers of the language * 

/* Abstract syntax and unparsing */ 

Id : IdNullO [ ~ ::= "*/S (PLACEHOLDER: <ident if ier>'/.S) " ] 

I Identifier (ID) [ : := ~ ] 

> 

/* Concrete input syntax */ 

id { synthesized Id abs; }; 

Id ~ id. abs; 

id : := (ID) { id. abs = Identif ier(ID) ; } 

I (IDENTIFIER.PLACEHOLDER) 

{ id. abs = IdNull ; > 



/ * Attribution */ 

Id {synthesized ID name; 

synthesized BOOL partial; 

>; 

Id : IdNull { 
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Id. name = ".undeclared" ; 
Id. partial = true; 

> 

I Identifier { 

Id. name = ID; 

Id. partial = false; 

> 



* File Name : if.ssl * 

* Purpose : Defines the if-then-else construct * 

/* Abstract syntax */ 

exp : Cond(exp exp exp); 

/* Minimal parenthesization */ 

exp : Cond { 

exp$2 .precedence = 0; 
exp$3 .precedence = 0; 
exp$4. precedence = 0; 

} 

; 

/* Unparsing */ 

exp : Cond 

[~ ::= "*/t*/.{*/„S (KEYWORD: if %S) " Q " '/c’/S (KEYWORD : then'/.S) " <9 
" y.c'/.S (KEYWORD :else'/S) " @ " '/.b'/c'/S (KEYWORD :f i'/S) 0 /.}"] 

3 

/* Template commands */ 

transform exp 

on "if" <exp>: Cond(<exp>, <exp>, <exp>) , 

on "if" e when (e != <exp>) : Cond(<exp>, e, <exp>) 

3 

/* Concrete input syntax */ 

Exp ::= (IF Exp THEN Exp ELSE Exp FI) 

{ Exp$l.abs = Cond(Exp$2 . abs, Exp$3.abs, Exp$4.abs); } 
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* File Name : if_infer.ssl * 

* Purpose : Type inference for if-then-else construct * 

exp : Cond { 

exp$2 .typeEnv = exp$l . typeEnv ; 
exp$2 . letvars = exp$l .letvars; 
exp$3 . letvars = exp$l . letvars ; 
exp$4 . letvars = exp$l .letvaxs; 
exp$2.s = exp$l.s; 

exp$3.s = Unify (exp$2 . typeAssignment , IntType, exp$2.S); 
exp$3 .typeEnv = ApplySubstToTypeEnv(exp$3. s, exp$l .typeEnv) ; 
exp$4.s = exp$3.S; 

exp$4. typeEnv = ApplySubstToTypeEnv(exp$3 . S , exp$l .typeEnv) ; 
exp$l.S = Unif y(exp$3. typeAssignment , exp$4 . typeAssignment , 
exp$4 . S) ; 

exp$l .typeAssignment = exp$3 .typeAssignment ; 
exp$l .partial = exp$2. partial II exp$3. partial II 
exp$4 . partial ; 
exp$4.sv = exp$l.sv; 
exp$3.sv = exp$l.sv; 
exp$2.sv = exp$l.sv; 
exp$4.encl = exp$l.encl; 
exp$3.encl = exp$l.encl; 
exp$2.encl = exp$l.encl; 
exp$2.top = false; 
exp$3.top = false; 
exp$4.top = false; 

> 

J 

exp : Cond {in TypeErrors on (exp$l.S == FailSubst && 

exp$2.S != FailSubst && exp$3.S != FailSubst && 
exp$4.S != FailSubst); } [ TypeErrors 0 : "If'/.n" ] 



/******************************************************************** 
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* File Name : infer. ssl * 

* Purpose : Implementation of the type inference for * 

* Poly C. This implementation is based on * 

* Dennis Volpano's implementation for core ML with * 

* letvar and first-class refs. * 



STR foreign newsymiO; /* generate symbols *1, * 2 , *3 .... */ 

/* Poly C has only weak type variables.*/ 

TYPEVAR : WeakVar (STR) [0 : © ] 



/* We need this phylum to type the functions of Poly C */ 
list TYPEEXPLIST; 

TYPEEXPLIST : TypeExpListNil () [<B:] 

| TypeExpListPair(TYPEEXP TYPEEXPLIST) 

[ © : ‘ ["‘/.S (OPERATOR: \<times> %S)Jio"] © ] 



TYPEEXP : NullTypeO 

I UniversalTypeO 
I IntType () 

| RealType () 

I UnitType () 



[@ : "?" ] 

[@ : "\<bottom>" ] 
[© : "int" ] 

[@ : "real" ] 

[© : "unit" ] 



I TypeVar (TYPEVAR) [@ : © ] 

I MapType (TYPEEXPLIST TYPEEXP) [© : "(" © "'/.S (OPERATOR: 
\<right arrow> # /,S)y,o" © ")" ] 

I PairType (TYPEEXP TYPEEXP) [© : "(" © " \<times> " © ")" ] 
I RefType (TYPEEXP) [@ : © " ptr" ] 



TYPESCHEME 

: TypeExp (TYPEEXP) [fi : ©] 

I TypeVarBinding (TYPEVAR TYPESCHEME) [© : "\<forall>" © "." @] 



TYPEEXP TypeExpOfTypeScheme (TYPESCHEME t) { 
with(t) ( 

TypeExp (e) : e, 

TypeVarBinding(i , s) : TypeExpOfTypeScheme (s) , 

) 
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>; 



/* Substitutions : Finite functions mapping type variables to types 
* Empty substitution is denoted by IdSubst 
*/ 

SUBST : FailSubst () [© : "FailSubst"] 

I IdSubst () [0 : ] 

I SubstConcat (TYPEVAR TYPEEXP SUBST) 

[@ : "%{<" © © ">y.o" © "%>" ] 



BOOL InSubst (TYPEVAR tyvar, SUBST s) { 
with(s) ( 

FailSubst: false, 

IdSubst: false, 

SubstConcat (j , *, sub): j == tyvar ? true : InSubst (tyvar, sub), 

) 

>; 

TYPEEXP LookupInSubst (TYPEVAR tyvar, SUBST s) { 
with(s) ( 

FailSubst: NullType, 

IdSubst: UniversalType , 

SubstConcat (j , t, sub): j == tyvar ? t : 

LookupInSubst (tyvax, sub), 
default : tyvar 

) 

>; 

TYPEEXP Ult (TYPEEXP t, SUBST s) { /* close substitution s for t */ 

with (t) ( 

TypeVar(v) : InSubst (v, s) ? 

Ult (LookupInSubst (v , s) , s) : t, 
default : t 

) 

>; 

TYPEEXP RecRealAux (TYPEEXP t, SUBST s) { 
with (t) ( 

TypeVar(v) : let e = LookupInSubst (v, s) in ( 
with(e) ( 
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NullType: t, 

UniversalType : t, 
default: RecRealAux(e , s) 

) 

), 

MapType(u, w) : MapType (RecRealList Aux(u, s) , RecRealAux(w, s)), 
PairType(u, w) : PairType(RecRealAux(u, s) , RecRealAux(w, s)), 
RefType(u): RefType(RecRealAux(u, s)), 
default: t 

) 

}; 

TYPEEXPLIST RecRealList Aux(TYPEEXPLIST 1, SUBST s) { 
with(l) ( 

TypeExpListPair (v , 1) : RecRealAux(v, s) :: RecRealList Aux(l , s), 
default : 1 

) 

>; 

TYPEEXP RecReal(TYPEEXP t, SUBST s) { 
with(s) ( 

FailSubst: NullType, 

IdSubst: t, 

default: RecRealAux(t , s) , 

) 

>; 

SUBST RemoveFromSubst (SUBST s, TYPEVAR id) { 
with (s) ( 

FailSubst: FailSubst, 

IdSubst: IdSubst, 

SubstConcat (i , t, sub): 

i == id ? sub : SubstConcat (i , t, RemoveFromSubst ( sub , id)), 

) 

>; 

TYPEEXP ApplySubstToTypeVar (SUBST s, TYPEVAR v) { 
with (s) ( 

FailSubst: NullType, 

default: let t = LookupInSubst(v, s) in ( 
with (t) ( 

UniversalType: TypeVar(v) , 



69 



default: ApplySubstToTypeExp (s , t) 

) 

)) 

}; 



TYPEEXP ApplySubstToTypeExp (SUBST s, TYPEEXP t) { 
with(s) ( 

FailSubst: NullType, 

IdSubst : t, 
default : 
with(t) ( 

TypeVar(u): ApplySubstToTypeVar (s , u) , 

MapType(tl, t2) : MapType(ApplySubstToTypeExpList(s, tl), 

ApplySubstToTypeExp (s , t2)), 
PairType(tl, t2) : PairType(ApplySubstToTypeExp(s, tl) , 

ApplySubstToTypeExp (s , t2)), 
RefType(t): RefType (ApplySubstToTypeExp (s , t)), 
default : t 
) 

) 

>; 



TYPEEXPLIST ApplySubstToTypeExpList (SUBST s, TYPEEXPLIST t) { 
with(t) ( 

TypeExpListPair(v, 1): ApplySubstToTypeExp (s , v) : : 

ApplySubstToTypeExpList (s, 1), 

default : t 

) 

>; 



TYPESCHEME ApplySubstToTypeScheme (SUBST s, TYPESCHEME t) { 
with(t) ( 

TypeExp(e): TypeExp (ApplySubstToTypeExp (s , e)), 
TypeVarBinding(i, u) : 

TypeVarBinding(i , ApplySubstToTypeScheme(RemoveFromSubst ( 
s, i) , u)) , 

) 

}; 
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* let/letarr/letvar-bound identifier list * 



list LVLIST; 

LVLIST : LVNil () [fi : ] 

I LVCons (Id LVLIST) [<§ : 0 [", "] <D ] 



LVLIST RemoveFromLVList (Id id, LVLIST 1) { 
with (1) ( 

LVNil : 1, 

LVCons (v as IdNullO, rest) : 

v :: RemoveFromLVList (id, rest), 
LVCons (v, rest) : (v == id) ? rest : 
v :: RemoveFromLVList (id, rest) 

) 

>; 



BOOL InLVList (Id id, LVLIST 1) { 
with(l) ( 

LVNil : false, 

LVCons(v, rest) : (v == id) ? true : InLVList (id, rest), 

) 

h 

* variable/identifier list * 

list VLIST ; 

VLIST : BVNilO [© : ] 

I BVCons (Id VLIST) [@ : @ [", "] <§ ] 



BOOL InVList (Id id, VLIST 1) { 
with(l) ( 

BVNil : false, 

BVCons(v, rest) : (v == id) ? true : InVList(id, rest), 

) 

>; 
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* static (top level) variable/ identifier list * 

* These identifiers are the ones whose * 

* declaration satisfies the conditions to become* 

* top level as explained in Chapter I. * 

list SVLIST ; 

SVLIST : SVNilO [fi : ] 

I SVCons(Id SVLIST) [fi : fi [" , "] 0 ] 



* Type environments * 

TYPEENV : NullTypeEnvO [fi : ] 

I TypeEnvConcat (ID TYPESCHEME TYPEENV) 

[fi : "UC" fi fi "]'/.o" fi ] 



/* 

* RemoveFromTypeEnv 

* 

* Remove entry for id from s. 

* Note: we assume s contains only one entry for id. 

*/ 

TYPEENV RemoveFromTypeEnv (ID id, TYPEENV s) { 
with(s) ( 

NullTypeEnv: s, 

TypeEnvConcat (i , t, tail): 
id == i ? tail 

: TypeEnvConcat (i , t, RemoveFromTypeEnv ( id , tail)) 

) 

>; 



TYPESCHEME LookupInTypeEnv(lD id, TYPEENV s) { 
with(s) ( 

NullTypeEnv: TypeExp (UniversalType) , 

TypeEnvConcat (i , t, tail): id == i ? t : LookupInTypeEnv(id, 
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) 



tail) 



}; 

TYPEENV ApplySubstToTypeEnv (SUBST s, TYPEENV e) { 
with(s) ( 

IdSubst: e, 

FailSubst: e, 
default : 

with(e) ( 

NullTypeEnv: NullTypeEnv, 

TypeEnvConcat (i, t, tail): 

TypeEnvConcat (i , ApplySubstToTypeScheme (s , t) , 
ApplySubstToTypeEnv(s , tail)), 

) 

) 

>; 

* Generate a generic instance * 

/* list of type variables */ 
list TVLIST ; 

TVLIST : TVNilO [<§ : ] 

I TVCons(TYPEV AH TVLIST) [<3 : @ [" , "] 0 ] 



/* return all type vars in type exp t */ 

TVLIST Tvarsln (TYPEEXP t, TVLIST 1) { 
with (t) ( 

TypeVar(v) : v :: 1, 

MapType(tl ,t2) : Tvarsln(t2 ,TvarsInList (tl , 1) ) , 

PairType(tl ,t2) : Tvarsln(t2 , Tvarsln (tl , 1) ) , 
RefType(t) : Tvarsln(t, 1), 

default : 1 

) 

>; 



TVLIST TvarsInList (TYPEEXPLIST t , TVLIST 1) { 
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with(t) ( 

TypeExpListPair(v, rest) : TvarsInList (rest , Tvarsln(v, 1)), 
default : 1 

) 

>; 



/* is type var x in type var list? */ 

BOOL InTVList (TYPEVAR x, TVLIST 1) { 
with(l) ( 

TVNil : false, 

TVCons(v, rest) : (v == x) ? true : InTVList (x, rest) 

) 

>; 



/* all x members not in y */ 
TVLIST Bar (TVLIST x, TVLIST y) { 
with (x) ( 

TVNil : TVNil, 



) 



TVCons(v,rest) : InTVList (v, y) 
: TVCons(v, Bar(rest, y)) 



>; 



? Bar(rest,y) 



/* free type vars in scheme */ 

TVLIST FreeScheme (TYPESCHEME s, TVLIST scvs) { 
with (s) ( 

TypeExp(t) : Bar( Tvarsln(t , TVNil) , scvs), 
TypeVarBinding(v, rest) : FreeScheme (rest , 

) 

>; 



TVCons (v , scvs) ) , 



/* free type vars in type environment */ 

TVLIST FreeTe (TYPEENV te) { 
with(te) ( 

NullTypeEnv: TVNil, 

TypeEnvConcat (i,t,tail) : FreeScheme (t , TVNil) @ FreeTe(tail) , 



) 



>; 
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/* return a list of noduplicates */ 

TVLIST Nodups (TVLIST 1, TVLIST acc) { 
with(l) ( 

TVNil : acc, 

TVCons(v, tail) : 

InTVList (v,acc) ? Nodups (tail, acc) 

: Nodups (tail, TVCons (v,acc)) , 

) 

>; 



TYPESCHEME MkScheme (TVLIST vs, TYPEEXP t) { 
with(vs) ( 

TVNil: TypeExp(t), 

TVCons(v, tail): 

TypeVarBinding(v , MkScheme(tail,t)) , 

) 

>; 



/* normal closure */ 

TYPESCHEME Close (TYPEENV a, TYPEEXP t) { 

MkScheme (Bar (Nodups (Tvarsln(t, TVNil) , TVNil) , FreeTe(a)), t) 

>; 



/* instantiate a scheme */ 

TYPEEXP InstSchemeAux (TYPESCHEME ts, SUBST s) { 
with(ts) ( 

TypeExp(t) : ApplySubstToTypeExp(s , t) , 
TypeVarBinding(v, rest) : 

InstSchemeAux (rest , SubstConcat (v , 
TypeVar (WeakVar(newsymi() )) , s)) 

) 

>; 



TYPEEXP Inst Scheme (TYPESCHEME s) { 
InstSchemeAux (s, IdSubst) 



75 



>; 



* Unification of type expressions * 

SUBST Unify (TYPEEXP t, TYPEEXP u, SUBST s) { 

s == FailSubst ? FailSubst : Equate(Ult(t, s) , Ult(u, s) , s) 

>; 



/* unifies lefthand side of a function space operator */ 

SUBST UnifyList(TYPEEXPLIST t, TYPEEXPLIST u, SUBST s) { 

(s == FailSubst) ? FailSubst : 
with (t) ( 

TypeExpListPair(vl , restl) : 
with(u) ( 

TypeExpListPair (v2, TypeExpListNilO ) : 

Equate (Ult(vl, s) , Ult(v2, s) , s) , 

TypeExpListPair (v2 , rest2) : 

UnifyList (restl , rest2, Equate(Ult(vl, s) , Ult(v2, s) , s)), 
default : s 

), 

default : s 

) 



/* returns length of a list */ 

I NT Length (TYPEEXPLIST 1) { 
with(l) ( 

TypeExpListPair (v, rest) : 1 + Length(rest) , 
default : 0 

) 

}; 



SUBST Equate (TYPEEXP t, TYPEEXP u, SUBST s) { 
t == u ? s : 
with (t) ( 
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UniversalTypeO : s, 

TypeVar(v) : 
with(u) ( 

UniversalTypeO: s, 

default: TypeVarOccurCheck(v , u, s) ? FailSubst : 
SubstConcat(v, u, s) , 

), 

RefType(tl) : 
with(u) ( 

UniversalTypeO: s, 

TypeVar(ul) : Equate(u, t, s) , 

RefType(ul): Unify(tl, ul, s) , 
default: FailSubst, 

), 

MapType(tl, t2) : 
with(u) ( 

UniversalTypeO: s, 

TypeVar(ul): Equate(u, t, s) , 

MapType(ul, u2) : (Length(tl) == Length(ul)) ? 

Unify(t2, u2, UnifyList (tl , ul, s)) : FailSubst, 
default: FailSubst, 

), 

PairType(tl, t2) : 
with(u) ( 

UniversalTypeO: s, 

TypeVar(ul) : Equate(u, t, s) , 

PairType(ul, u2) : Unify(t2, u2, Unify(tl, ul, s)), 
default: FailSubst, 

), 

default : 

with(u) ( 

UniversalTypeO: s, 

TypeVar(ul): SubstConcat (ul , t, s) , 
default: FailSubst, 

), 

) 

>; 



BOOL TypeVarOccurCheck(TYPEVAR v, TYPEEXP t, SUBST sub) { 
with(t) ( 

UniversalTypeO: false. 
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TypeVar(u) : (u == v) II (InSubst(u, sub) && 

TypeVarOccurCheckCv, LookupInSubst (u, sub), sub)), 
MapType(tl, t2) : TypeVarOccurCheckList (v, tl, sub) II 
TypeVarOccurCheck(v, t2, sub), 

PairType(tl, t2) : TypeVarOccurCheckCv, tl, sub) || 

TypeVarOccurCheck(v, t2, sub), 

RefType(tl): TypeVarOccurCheckCv, tl, sub), 
default: false 
) 

>; 



/* implement TypeVarOccurCheck for a list of type expressions */ 

BOOL TypeVarOccurCheckList (TYPEVAR v, TYPEEXPLIST t, SUBST sub) { 
with(t) ( 

TypeExpListPair(u, rest) : 

TypeVarOccurCheckCv, u, sub) ? true 

: TypeVarOccurCheckList Cv, rest, sub). 



default : false 

) 

>; 



/* Is e a value of Poly C ? */ 
BOOL NonExpansive Cexp e) { 
withCe) C 



PairCs, t) 
Ident C*) 
LambdaC*, *) 
default 
) 



>; 



NonExpansive (s) 

true , 

true, 

false 



NonExpansive Ct) , 



/* Initial type environment is empty */ 
TYPEENV InitialEnvironmentC) { NullTypeEnv }; 



/*** * ****+ ***:(:*:+: * ****** *** * ********** * ** **** ****** *** *** *** *** ****** * 

* File Name : int.ssl * 

* Purpose : Integer operators * 
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/* Abstract syntax */ 

exp : IntOp (INT) 

I Sum, Diff, Prod, Quot(exp exp) 

I LessThan, LessThanOrEqual , GreaterThan, 

Great erThanOrEqual (exp exp) 



/* Minimal parenthesization */ 

exp : Sum, Diff PP2(6) 

I Prod, Quot PP2(7) 

I LessThan, LessThanOrEqual, GreaterThan, Great erThanOrEqual 
PP2 (5) 



/* Unparsing */ 

exp : IntOp [ : ] 

I Sum [ “ ::= '7.{ 8 /,S (PUNCTUATION : " lp "*/ 0 S)" © " 8 /,S (OPERATOR :+ # /„S) 
8 /.o " © "*/.S (PUNCTUATION:" rp '7.S) 8 /,}" ] 

I Diff [ * ::= " 8 /.{ 8 /.S (PUNCTUATION : " lp '7.S)" © " '/.S (OPERATOR: - 8 /.S) 

7.0 " © "“/.S (PUNCTUATION:" rp " , /.S) , /.>" ] 

I Prod [■'::= S (PUNCTUATION : " lp " 8 /„S)" © " */,S (OPERATOR: * # /„S) 

7.0 " © M, /,S (PUNCTUATION:" rp '"/.S)*/.}" ] 

I Quot [ “ "°/{’/»S (PUNCTUATION : " lp '7,S)" @ " °/„S (OPERATOR: /°/ 0 S) 

7.o " © "“/.S (PUNCTUATION:" rp " , /.S) , /.>" ] 

I LessThan [ ' ::= " , /»{ , /.S( PUNCTUATION: " lp M, /.S)" © " 

7.S (OPERATOR: <*/,S) , /.o " © " C /.S (PUNCTUATION : " rp "“/.S) 8 /.}"] 
I LessThanOrEqual [ “ : := "“/.{“/.S (PUNCTUATION : " lp ’7.S)" © " °/.S( 

OPERATOR : , /,<le> , /.S)'/,o " © "%S (PUNCTUATION: " rp "“/.S) 8 /.}"] 
I GreaterThan [ “ : := " 8 /,{ 8 /.S (PUNCTUATION: " lp " 8 /.S)" © " 8 /„S( 

OPERATOR :> 8 /,S) 8 /,o " © " 8 /,S (PUNCTUATION: " rp " 8 /,S) 8 /,>"] 
I Great erThanOrEqual [ “ ::= " 8 /.{ 8 /.S (PUNCTUATION: " lp ,,8 / t S)" © " 

8 /,S (OPERATOR : 8 /.<ge> 8 /.S) 8 /.o " © " 8 /,S (PUNCTUATION : " rp " 8 /.S)y.>"] 



/* Template commands */ 

transform exp 

on "+" <exp> : Sum(<exp>, <exp>) , 
on <exp> : Diff(<exp>, <exp>) , 

on <exp> : Prod(<exp>, <exp>) , 

on "/" <exp> : Quot(<exp>, <exp>) , 
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on "<" <exp> : LessThan (<exp> , <exp>) , 
on "<=" <exp> : LessThanOrEqual(<exp> , <exp>) , 
on ">" <exp> : GreaterThan(<exp> , <exp>) , 
on ">=" <exp> : GreaterThanOrEqual(<exp> , <exp>) 



/* Concrete input syntax 



*/ 



Exp 



(INTEGER) 



■C Exp$l . abs = IntOp (STRtoINT( INTEGER) ) ; > 

•( Exp$l.abs = Sura( Exp$2.abs, Exp$3.abs); } 

{ Exp$l.abs = Diff (Exp$2. abs, Exp$3.abs); } 

{ Exp$l.abs = Prod (Exp$2 . abs, Exp$3.abs); } 

{. Exp$l.abs = Quot (Exp$2 . abs, Exp$3.abs); } 

{ Exp$l.abs = LessThan (Exp$2 . abs , Exp$3.abs); } 
(Exp LESSEQUAL Exp prec LESSEQUAL) 

{ Exp$l.abs = LessThan0rEqual(Exp$2 .abs, Exp$3.abs); } 

(Exp ’>’ Exp) {Exp$l.abs = Great erThan (Exp$2 . abs , Exp$3.abs); } 
(Exp GREATEREQUAL Exp prec GREATEREQUAL) 

{ Exp$l.abs = GreaterThan0rEqual(Exp$2.abs, Exp$3.abs); } 



(Exp 

(Exp 

(Exp 

(Exp 

(Exp 



; _ ) 
> * > 

>r 

><> 



Exp) 

Exp) 

Exp) 

Exp) 

Exp) 



* File Name : int_infer . ssl * 

* Purpose : Type inference for integer operators * 

exp : IntOp { 

exp .typeAssignment = IntType; 

exp . S = exp . s ; 

exp. partial = false; 

> 

I Sum, Diff, Prod, Quot { 

exp$2 .typeEnv = exp$l.typeEnv; 
exp$2 . letvars = exp$l . letvars; 
exp$3 . letvars = exp$l . letvars; 
exp$2.s = exp$l.s; 

exp$3.s = Unify (exp$2. typeAssignment, IntType, exp$2.S); 
exp$3 . typeEnv = ApplySubstToTypeEnv(exp$3 . s , 
exp$l .typeEnv) ; 

exp$l.S = Unify (exp$3 . typeAssignment , IntType, exp$3.S); 
exp$l. typeAssignment = IntType; 
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exp$l .partial = exp$2 .partial || exp$3. partial; 

exp$3.sv = exp$l.sv; 

exp$2.sv = exp$l.sv; 

exp$3.encl = exp$l.encl; 

exp$2.encl = exp$l.encl; 

exp$2.top = false; 

exp$3.top = exp$l.top; 

> 

LessThan, LessThanOrEqual, GreaterThan, Great erThanOrEqual { 
exp$2 . typeEnv = exp$l . typeEnv ; 
exp$2 . letvars = exp$l . letvars ; 
exp$3 . letvars = exp$l . letvars ; 
exp$2 . s = exp$ 1 . s ; 

exp$3.s = Unify(exp$2.typeAssignment, IntType, exp$2.S); 

exp$3 .typeEnv = ApplySubstToTypeEnv(exp$3 . s , exp$l .typeEnv) ; 

exp$l.S = Unify (exp$3.typeAssignment , IntType, exp$3.S); 

exp$l .typeAssignment = IntType; 

exp$l .partial = exp$2 .partial II exp$3 .partial ; 

exp$3.sv = exp$l.sv; 

exp$2.sv = exp$l.sv; 

exp$3.encl = exp$l.encl; 

exp$2.encl = exp$l.encl; 

exp$2.top = false; 

exp$3.top = exp$l.top; 



Sum, Diff, Prod, Quot { in TypeErrors on (exp$l.S == FailSubst 
kk exp$2.S != FailSubst kk exp$3.S != FailSubst); 

> 



Sum 


[ TypeErrors 0 : 


"Sum’/.n" ~ 


“ ] 


Diff 


[ TypeErrors 0 


: "Diff*/ 0 n" 


‘ “ ] 


Prod 


[ TypeErrors @ 


: "Prod'/.n" 


“ “ ] 


Quot 


[ TypeErrors @ 


: "Quot*/,n" 


“ “ ] 



LessThan, LessThanOrEqual, GreaterThan, Great erThanOrEqual { 
in TypeErrors on (exp$l.S == FailSubst kk exp$2.S != 

FailSubst kk exp$3.S != FailSubst); 

> 

LessThan [ TypeErrors @ : "LessThany«n" ] 

LessThanOrEqual [ TypeErrors @ : M LessThanOrEqual # / 0 n" ] 
GreaterThan [ TypeErrors @ : "GreaterThan'/n" ] 

Great erThanOrEqual 
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[ TypeErrors <9 : "GreaterThanOrEqual’/.n" ] 



/ ******************************************************************** 

* File Name : lambda. ssl * 

* Purpose : * 

******************************************************************** / 
/* An address is a pair of a segment and an offset. */ 

# define SEGMENT STR 

# define OFFSET STR 

/* Formal parameters of a function is a list of identifiers. */ 

/* Abstract syntax */ 

list formalParamList ; 

f ormalParamList : FormalParamListNilO 

I FormalParamListPair(Id formalParamList) 



FormalParamList { synthesized formalParamList abs; }; 



/* Actual parameters of an application is a list of expressions. */ 

/* Abstract syntax */ 

list actualParamList ; 

actualParamList : ActualParamListNilO 

I ActualParamListPair(exp actualParamList) 

) 

ActualParamList { synthesized actualParamList abs; }; 

/* */ 



/* Abstract syntax */ 

exp : VoidExpO 

I Refloc, Varloc (LOCATION) 

I Ident (Id) 

I Lambda(f ormalParamList exp) 

I Call (exp actualParamList) 
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LOCATION : 



NullLocO [<§ : ] 

Loc (SEGMENT OFFSET) [ ~ : "C( 



II ~ II II ~ II ^ II 



] 



/* Minimal parenthesization */ 

exp { inherited INT precedence; }; 



# define PPl(n) {\ 
local STR lp;\ 
local STR rp;\ 
exp$2 .precedence = (n);\ 
lp = ($$ .precedence > (n)) ? "(" : 
rp = ($$ .precedence > (n) ) ? ")" : 
> 



# define PP2(n) {\ 
local STR lp;\ 
local STR rp;\ 
exp$2 .precedence = (n);\ 
exp$3 .precedence = (n)+l;\ 
lp = ($$ .precedence > (n) ) ? "(" : 
rp = ($$ .precedence > (n) ) ? ")" : 
> 



/* 

* Values are a subset of the expressions, so SSL expects values to 

* to be attributed as well since expressions are attributed. But the 

* attribution is not important so we define two macros to silence SSL 
*/ 



# define SYNSILENCE(P) P.typeAssignment = NullType;\ 

P.S = IdSubst () ; \ 

P. partial = false; 

# define INHSILENCE(P) P.typeEnv = NullTypeEnv; \ 

P.letvars = LVNil();\ 

P.s = IdSubst () ; \ 

P. precedence = 0;\ 

P.sv = SVNilQ ; \ 

P.encl = true;\ 
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P.top = false; 



exp : Call PP1(0) 

I Lambda PP1(0) 



/* Unparsing — 
exp : VoidExp 

I Ident 
I Refloc 
I Varloc 
I Call 

I Lambda 



[•'::= ’7.S (PLACEHOLDER :<exp> # /„S)" ] 

[ ‘ “ ] 

[ ‘ ] 

[ “ : " ] 

[ ~ ::= <3 "’/.US (PUNCTUATION : (%S)°/.o" <3 
’7.S (PUNCTUATION: ) # /.S) # /„>"] 



[ * : : = '"/.US ( PUNCTUATI ON : " lp " ’/. S ) # /.S ( PUNCTUATI ON : 
X<lambda>('/.S)" <3 ’7.S (PUNCTUATION :)y.S)%S (PUNCTUATION: 
{%S)XL" <3 ’7,S (PUNCTUATION : } XS)XS (PUNCTUATION: 

" r P n y.s)" "y.by.>"] 



*/ 



/* Template rules */ 

transform exp 

on "fun" e: Lambda(<f ormalParamList> , e) , 

on "call" <exp> : Call(<exp>, <actualParamList>) , 
on "call" e : Call(e, <actualParamList>) 



/* Concrete input syntax */ 

Exp { synthesized exp abs; }; 
exp ~ Exp . abs ; 

Exp ::= (EXP.PLACEHOLDER) { Exp. abs = VoidExp; > 

I (id) { Exp. abs = Ident (id. abs) ; } 

I (LAMBDA ’(' FormalParamList ' ) ’ ’ {' Exp * }') 

{ Exp$l.abs = Lambda(FormalParamList . abs , Exp$2.abs); } 

I ('(' Exp ')') 

{ Exp$l.abs = Exp$2.abs ; } 

I (Exp ' ( ’ ActualParcuaList ’) ’ ) 
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{ Exp$l.abs = Call (Exp$2 . abs, ActualParamList . abs) ; } 



/* Unparsing */ 

f ormalParamList : FormalParamListNil [@:] 

I FormalParamListPair [ @ : "JJ-C" “ ["’/.S (PUNCTUATION : 

,‘/.S) 7,o" ] @ "%>"] 



/* Concrete input syntax */ 

f ormalParamList ~ FormalParamList . abs; 

FormalParamList : := (id) { FormalParamList . abs = 

(id. abs :: FormalParamListNil); } 
I (id FormalParamList) { FormalParamList$l . abs = 

(id. abs :: FormalParamList$2 . abs) ; } 



/* Unparsing */ 

actualParamList : ActualParamListNil [<§:] 

I ActualParamLi stPair [ <§ : ' ["‘/.S (PUNCTUATION : , */,S) 

7,o" ] 0 ] 



/* Concrete input syntax */ 

actualParamList ~ ActualParamList . abs ; 

ActualParamList : := (Exp) { ActualParamList . abs = Exp. abs :: 

ActualParamListNil () ; } 
I (Exp ’ ActualParamList) { ActualParamLi st$ 1 . abs = 

Exp. abs :: ActualParamList$2 . abs ; } 



/ *************************************************** ********* ******** 

* File Name : lambda_inf er . ssl * 

* Purpose : * 

/* Common attributes of exp and actualParamList. 

* Attibutes end, top and sv are used in checking if 

* the free identifiers of a lambda abstraction are top level, 
end shows if an expression is enclosed by a lambda abstraction; 
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top shows if an expression occurs in a top level scope. For 
instance in letvar x = e_l in e_2, e.l.top is always false. 

If this letvar expression is enclosed by an expression e then 
e_2.top gets the same value as the value of e.top. Otherwise, 
e_2.top is true; sv is a list of top level identifiers. 

*/ 

exp, actualParamList { 

inherited TYPEENV typeEnv; 
inherited LVLIST letvars; 
synthesized BOOL partial; 
synthesized SUBST S; 
inherited SUBST s; 
inherited BOOL end; 
inherited BOOL top; 
inherited SVLIST sv; 

>; 



/* Types of expressions of an actualParamList are hold in 

* texlist. texlist is a TYPEEXPLIST which is implemented 

* using SSL list. 

*/ 

actualParamList { synthesized TYPEEXPLIST texlist; }; 

exp { synthesized TYPEEXP typeAssignment ; }; 

actualParamList : ActualParamListPair { 

actualParamList $1 .texlist = exp . typeAssignment : : 

actualParamList$2 . texlist ; 
exp. typeEnv = actualParamList $1 .typeEnv; 
actualParamList$2. typeEnv = ApplySubstToTypeEnv(exp . S , 

actualParamList $1 .typeEnv) ; 
exp. letvars = actualParamList $1 . letvars ; 
actualParamList$2 . letvars = actualParamList $1 . letvars ; 
exp . s = actualParamList $1 . s ; 
actualParamList$2 . s = exp.S; 
exp. end = actualParamList $1 . end ; 
actualParamList$2 . end = actualParamList$l.encl; 
exp. top = false; 
actualParamList$2 . top = false; 
exp.sv = actualParamList$l . sv; 
actualParamList$2 . sv = actualParamList$l . sv ; 
actualParamList$l . S = actualParamList$2 . S ; 
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>; 



term 



term 



exp : 



actualParamList$l .partial = exp. partial I I 

actualParamList$2 .partial ; 

exp .precedence = 0; 

> 

I ActualParamListNil { 
actualParamList . texlist = TypeExpListNil; 
actualParamList . S = actualParamList . s ; 
actualParamList . partial = false; 



Static, Dynamic { 
local SUBST finalSubst; 
finalSubst = exp.S; 
exp.typeEnv = InitialEnvironment () ; 
exp.s = IdSubst; 

exp.letvars = IdNullO :: LVNil; 
local TYPESCHEME f inalTypeScheme ; 
f inalTypeScheme = 

NonExpansive(exp) ? Close (NullTypeEnv, 

RecReal(exp. typeAssignment , exp . S) ) 

: TypeExp(RecReal( exp. typeAssignment, exp.S)); 

exp. top = true; 
exp. end = false; 
exp . sv = SVNil () ; 

> 



: Static [ ~ @ '7.n°/.S (PUNCTUATION: :°/.S) " f inalTypeScheme ] 

I Dynamic { 

local exp val; 

val = (exp.S == FailSubst) | | (exp . partial) ? 

Ident (Identif ier("?") ) 

: let EvalPair(v, *) = eval(exp, NullMem) in (v) ; 

> 

C “ : <9 "Xnval " val " # /.S (PUNCTUATION: : a /.S) " f inalTypeScheme ] 

) 

VoidExp { 

exp. typeAssignment = TypeVar (WeakVar (newsymi () ) ) ; 
exp . S = exp . s ; 
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> 



exp. partial = true; 



I Refloc, Varloc {SYNSILENCE(exp) } 

I Ident { 

local TYPESCHEME binding; 

binding = LookupInTypeEnv(Id.name, exp . typeEnv) ; 
exp .typeAssignment = InstScheme(binding) ; 
exp.S = binding == TypeExp(UniversalType) ? 

FailSubst /* Free variables cause inconsistency */ 
: exp . s ; 

exp. partial = Id. partial; 

> 

I Call { 

local TYPEVAR beta; 

exp$2 .typeEnv = exp$l . typeEnv ; 

exp$2.s = exp$l.s; 

exp$2 . letvars = exp$l . letvars ; 

actualParamList . letvars = exp$l . letvars ; 

actualParamList . s = exp$2.S; 

actualParamList .typeEnv = ApplySubstToTypeEnv(exp$2 . S , 

exp$l .typeEnv) ; 

exp$l.S = Unify (exp$2 . typeAssignment , 

MapType (actualParamList .texlist , TypeVar (beta) ) , 
actualParamList . S) ; 
beta = WeakVar (newsymi () ) ; 
exp$l .typeAssignment = TypeVar(beta) ; 

exp$l .partial = exp$2 .partial II actualParamList .partial ; 

actualParamList . sv = exp$l.sv; 

exp$2.sv = exp$l.sv; 

actualParamList . end = exp$l.encl; 

exp$2.encl = exp$l.encl; 

actualParamList .top = exp$l.top; 

exp$2.top = false; 

> 

I Lambda { 

local TYPEEXPLIST f ormalParamType ; 
local TYPEEXP tau; 

f ormalParamType = GenerateTypeVars(formalParamList) ; 
exp$l .typeAssignment = tau; 

tau = Closed (FreeVarsIn(exp$l , BVNil) , exp$l.sv) ? 
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MapType(formalParamType, exp$2 . typeAssignment) 
: NullTypeO; 

exp$l.S = ((tau == NullTypeO) | I 

MultipleOccurrenceIn(f ormalParamList) ) ? FailSubstO 

: exp$2.S; 

exp$2.s = exp$l.s; 

exp$2 . letvars = RemoveFPFromLVList (f ormalParamList , 

exp$l . letvars) ; 

exp$2 .typeEnv = TypeEnvConcatList (f ormalParamList , 

f ormalParamType , RemoveFPFromTypeEnv ( 
f ormalParamList , exp$l .typeEnv)) ; 
exp$l .partial = exp$2 . partial ; 

exp$2.sv= RemoveFPFromSVList (f ormalParamList , exp$l.sv); 
exp$2.top = false; 
exp$2.encl = true; 



sparse view TypeErrors; 

exp : Ident { in TypeErrors on (exp.S == FailSubst); } 

[ TypeErrors @ : "Id: " ‘ "‘/.n" ] 

I Lambda { in TypeErrors on (exp$l.S == FailSubst && 
exp$2.S != FailSubst); } 

[ TypeErrors @ : "Lambda*/, n" ] 



transform term 

on "eval-on" 

Static(e) 

when ((! e .partial) && (e.S != FailSubst)) : Dynamic(e) , 
on "eval-off" 

Dynamic(e) : Static(e) 



/* Return the free variables of e wrt bound variables list 1 */ 
VLIST FreeVarsIn (exp e, VLIST 1) { 
with (e) ( 

Ident (Identif ier(x) ) : InVList(Identif ier(x) , 1)? BVNil 
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: BVCons(Identif ier(x) , BVNil), 
AddrOf(e) : FreeVarsIn (e,l), 

Subscript (el , e2) : FreeVarsIn (el,l) @ FreeVarsIn (e2,l) , 

Assign(el, e2) : FreeVarsIn (el,l) ® FreeVarsIn (e2,l) , 

PtrAdd(el, e2) : FreeVarsIn (el,l) @ FreeVarsIn (e2,l) > 

Deref(e) : FreeVarsIn (e,l), 

Lambda(f, el) : FreeVarsIn (el, ConcatFormalParaxns(f , 1)), 

Let (Identifier (x) , el, e2) : FreeVarsIn (el,l) @ 

FreeVarsIn (e2 , Identifier (x) :: 1) , 
LetVar (Identif ier(x) , el, e2) : FreeVarsIn (el,l) <9 

FreeVarsIn (e2, Identif ier (x) : :1) , 
LetArr (Identif ier(x) ,el ,e2) : FreeVarsIn (el,l) (9 

FreeVarsIn (e2,Identifier(x) : :1) , 
Compose(el , e2) : FreeVarsIn (el,l) (9 FreeVarsIn (e2,l), 

Not(el) : FreeVarsIn (e,l), 

And(el, e2) : FreeVarsIn (el,l) <9 FreeVarsIn (e2,l), 

Or(el, e2) : FreeVarsIn (el,l) (9 FreeVarsIn (e2,l). 

Equal (el, e2) : FreeVarsIn (el,l) <9 FreeVarsIn (e2,l), 

NotEqual(el, e2) : FreeVarsIn (el,l) <9 FreeVarsIn (e2,l), 

Cond(el, e2, e3) : FreeVarsIn (el,l) <9 FreeVarsIn (e2,l) <9 

FreeVarsIn (e3,l), 

While(el, e2) : FreeVarsIn (el,l) @ FreeVarsIn (e2,l). 

Sum (el, e2) : FreeVarsIn (el,l) <9 FreeVarsIn (e2,l), 

Diff(el, e2) : FreeVarsIn (el,l) (9 FreeVarsIn (e2,l), 

Prod(el, e2) : FreeVarsIn (el,l) <9 FreeVarsIn (e2,l), 

Quot(el, e2) : FreeVarsIn (el,l) @ FreeVarsIn (e2,l), 

LessThaji(el , e2) : FreeVarsIn (el,l) <9 FreeVarsIn(e2,l) , 
LessThanOrEqual (el , e2) : FreeVarsIn (el,l) @ FreeVarsIn(e2,l) , 
GreaterThan(el , e2) : FreeVarsIn (el,l) @ FreeVarsIn(e2,l) , 
GreaterThanOrEqual(el , e2) : FreeVarsIn (el,l) @ FreeVarsIn(e2,l) , 
Pair(el, e2) : FreeVarsIn (el,l) <9 FreeVarsIn(e2,l) , 

Call(e,a) : FreeVarsIn (e,l) @ FreeVarsInList (a,l) , 
default: BVNil () /* constants and placeholders */ 

) 



VLIST ConcatFormalParams(f ormalParamList 1, VLIST bv) { 
with(l) ( 

FormalParamListPair(v, rest) : ConcatFormalParams(rest , v :: bv) , 
FormalParamListNil : bv 

) 

>; 
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/* A more general form of FreeVarsIn for finding the 
* free variables in a list of expressions. 

*/ 

VLIST FreeVarsInList (actualParamList 1, VLIST bv) { 
with(l) ( 

ActualParamListPair(e,rest) : 

FreeVarsIn(e , bv) @ FreeVarsInList (rest , bv) , 
default : BVNil() 

) 

>; 



/* Is fv a subset of 1. In other words, we check 
* if all the free varibles given by fv occur in 1 
*/ 

BOOL Closed (VLIST fv, SVLIST 1) { 
with(fv) ( 

BVNil : true, 

BVCons(v, rest) : 

InSVList(v, 1) ? Closed(rest, 1) 

: false 



) 



>; 



BOOL InSVList (Id id, SVLIST 1) { 
with (1) ( 

SVNil : false, 

SVCons (v, rest) : (v == id) ? true 
: InSVList (id, rest) 

) 



>; 



SVLIST RemoveFromSVList (Id id, SVLIST 1) { 
with (1) ( 

SVNil : 1, 

SVCons (v, rest) : (v == id) ? rest : 
v :: RemoveFromSVList (id, rest) 

) 

>; 
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?* Remove let/letvar/letarr bound variables given 
* 1 from b. 

*/ 

VLIST RemoveLetbounds (VLIST b, LVLIST 1) { 
with (b) ( 

BVNilO : BVNilO, 

BVCons(v, rest) : 

InLVList(v, 1) ? v: : RemoveLetbounds (rest,l) 
: RemoveLetbounds (rest,l) 

) 

}; 



/* Generate new type variables for the formal parameters 
* of a function. 

*/ 

TYPEEXPLIST GenerateTypeVars (f ormalParamList 1) { 
with (1) ( 

FormalParamListPair (f , rest) : 

TypeExpListPair(TypeVar(WeakVar(newsymi () ) ) , 
GenerateTypeVars (rest ) ) , 
default : TypeExpListNilQ 

) 

}; 



/* Remove the formal parameters from type environment */ 

TYPEENV RemoveFPFromTypeEnv(f ormalParamList 1, TYPEENV t ) { 
with(l) ( 

FormalParamListPair (Identifier (id) , rest) : 

RemoveFromTypeEnv(id,RenioveFPFromTypeEnv(rest , t)) , 
default : t 

) 

>; 

/* Add type assumptions for the formal parameters given by 1 

* to the type environment. Each formal parameter f in 

* position x of 1, is associated with the type expression given in 

* position x of type expression list e. 

*/ 

TYPEENV TypeEnvConcatLi st (f ormalParamList 1, TYPEEXPLIST e, TYPEENV t){ 
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with(l) ( 

FormalParamListPair(Identif ier(id) , restl) : 
with (e) ( 

TypeExpListPair(v, rest2) : TypeEnvConcat (id , TypeExp(v), 
TypeEnvConcatList (restl , rest2, t)), 
default : t 
), 

default : t 

) 



LVLIST RemoveFPFromLVList (f ormalParamList 1, LVLIST lv) { 
with(l) ( 

FormalParamListPair(v,rest) : 

RemoveFromLVList (v .RemoveFPFromLVList (rest , lv) ) , 
default : lv 

) 

>; 



SVLIST RemoveFPFromSVList (f ormalParamList 1, SVLIST sv) { 
with(l) ( 

FormalParamListPair(v,rest) : 

RemoveFromSVList (v, RemoveFPFromSVList (rest , sv)) , 
default : sv 

) 

>; 

/* Functions can only have distinct formal parameters. */ 
BOOL MultipleOccurrenceIn(f ormalParamList 1) { 
with(l) ( 

FormalParamListNil : false, 

FormalParamListPair(x, rest) : 

Occur(x, rest) ? true :MultipleOccurrenceIn(rest) 

) 

>; 



BOOL Occur(Id x, f ormalParamList 1) { 
with(l) ( 

FormalParamListNil : false, 
FormalParamListPair (y , rest) : 
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(x == y) ? true : Occur(x, rest) 

) 

>; 

/ *************** ******************************************** ********* 

* File Name : let.ssl * 

* Purpose : let and letvar declarations * 

/* Abstract syntax */ 

exp : Let (Id exp exp) 

I LetVar (Id exp exp) 



/ * Minimal parenthesization */ 

exp : Let, LetVar { 

exp$2 .precedence = 0; 
exp$3 .precedence = 0; 

> 



/* Unparsing */ 

exp : Let [ * ::= L’/,S (KEYWORD : let’/.S) " 0 " = " @ 

" °/.S (KEYWORD : in # /.S) “/.t'/ot'/.n" 0 " 0 /„b 0 /,b 0 / o n 0 /.S (KEYWORD : end’/.S) °/b 0 /}" ] 
I LetVar [ ~ "H'/.L’/.S (KEYWORD :letvar’/,S) " <§ " := " 0 

" ‘/,S (KEYWORD : in , /.S) , /,t'/ 0 t , /,n" 0 "’/ob'/b'/.n'/.S (KEYWORD : end*/ ( S) °/,b°/,}" ] 



/ * Template commands */ 

transform exp 

on "let" <exp>: Let(<Id>, <exp>, <exp>) , 

on "let<Id><exp>e" e when (e != <exp>) : Let(<Id>, <exp>, e) , 
on "let<Id>e<exp>" e when (e != <exp>) : Let(<Id>, e, <exp>) , 
on "letvar" <exp>: LetVar (<Id>, <exp>, <exp>) , 

on "letvar<Id><exp>e" e when (e != <exp>) : LetVar(<Id>, <exp>, e) , 
on "letvar<Id>e<exp>" e when (e != <exp>) : LetVar(<Id>, e, <exp>) 



/* Concrete input syntax */ 

Exp ::= (LET id ’=> Exp IN Exp END) { 

Exp$l.abs = Let(id.abs, Exp$2.abs, Exp$3.abs); 

> 
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I (LETVAR id ASSIGN Exp IN Exp END) { 

Exp$l.abs = LetVar (id . abs , Exp$2.abs, Exp$3.abs); 

} 



* File Name : let_inf er . ssl * 

* Purpose : Type inference for let and letvar * 

/* 

* Two local attributes, sigma and f inalTypeScheme , are needed in the 

* attribution of Let; sigma is used to extend the type environment, 

* while f inalTypeScheme gives the typing used in the alternative 

* unparsing rule. Type sigma may not be a final type scheme for 

* Id. name because it may contain type variables that get specialized 

* by an enclosing expression, e.g, letvar x=[] in 

* let y = (let z=x in 17) in l::x. The type of z is determined by 

* ,, l::x" of the enclosing expression "let y = . . . " . 

* Thus the final type scheme must be formed from the final 

* substitution finalSubst inherited from the root. This is done 

* using the upward remote attribute set {Static .finalSubst , 

* Dynamic .finalSubst} . 

* 

* If attribute f inalTypeScheme is used for both purposes, then a 

* type 2 circularity results--there is a mutual dependence between 

* f inalTypeScheme and finalSubst. 

* 

* Likewise local attribute tau of LetVar, used in the alternative 

* unparsing rule, must also be formed from finalSubst. 

*/ 

exp : Let { 

local TYPESCHEME sigma; 

local TYPESCHEME f inalTypeScheme ; 

exp$l.S = exp$3.S; 

exp$l .typeAssignment = exp$3 . typeAssignment ; 

exp$l .partial = Id. partial || exp$2 .partial I I exp$3 .partial; 

exp$2 . s = exp$l . s; 

exp$2 .letvars = exp$l . letvars ; 



95 



exp$3 . letvars = RemoveFromLVList (Id , exp$l . letvars) ; 
exp$2 . typeEnv = exp$l .typeEnv; 
exp$3.s = exp$2.S; 

exp$3 .typeEnv = TypeEnvConcat (Id . name , sigma, 
ApplySubstToTypeEnv(exp$2 . S , 

RemoveFromTypeEnv(ld .name, exp$l .typeEnv))) ; 

sigma = 

NonExpansive(exp$2) ? 

Close(ApplySubstToTypeEnv(exp$2 .S, exp$l .typeEnv) , 

RecReal (exp$2 .typeAssignment , exp$2 . S) ) 

: TypeExp (RecReal (exp$2 .typeAssignment , exp$2.S)); 
f inalTypeScheme = 

NonExpansive(exp$2) ? 

Close(ApplySnbstToTypeEnv(-CStatic .f inalSubst , 

Dynamic . f inalSubst} , exp$ 1 . typeEnv) , 

RecReal (exp$2 . typeAssignment , {Static .f inalSubst , 
Dynamic . f inalSubst}) ) 

: TypeExp (RecReal (exp$2 . typeAssignment , 

{Static .f inalSubst , Dynamic . f inalSubst}) ) ; 
exp$2.sv = exp$l.sv; 

exp$3 . sv = exp$l.top ? exp$l.encl ? RemoveFromSVList(Id, 

exp$l . sv) 

: SVCons (Id , exp$l . sv) 

: exp$l.sv; 

exp$3.encl = expSl.encl; 
exp$2.encl = exp$l.encl; 
exp$2.top = false; 
exp$3.top = exp$l.top; 

} 

I LetVar { 

local TYPEEXP tau; 

exp$l.S = exp$3.S; 

exp$l .typeAssignment = exp$3 .typeAssignment ; 

exp$l .partial = Id. partial |j exp$2 .partial II exp$3 . partial ; 

exp$2.s = exp$l.s; 

exp$2 . letvars = exp$l .letvars; 

exp$3 . letvars = (Id == IdNullO) ? exp$l . letvars 

: Id : : RemoveFromLVList (Id , exp$l . letvars) ; 
exp$2 .typeEnv = exp$l . typeEnv ; 
exp$3.s = FreeInLambda(ld.name, exp$3) ? 

Unify(TypeVar(WeakVar(newsymi() )) , 
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exp$2. typeAssignment, exp$2.S) 

: exp$2.S; 
exp$3.typeEnv = 

TypeEnvConcat (Id. name, TypeExp(exp$2 .typeAssignment) , 
ApplySubstToTypeEnv(exp$3. s , RemoveFromTypeEnv( 

Id. name, exp$l . typeEnv) ) ) ; 

/* use RecReal here only because alternative unparsing rule 
displays type tau so type must be closed */ 
tau = RecReal (exp$2 .typeAssignment, {Static .finalSubst , 
Dynamic. finalSubst}) ; 
exp$2.sv = exp$l.sv; 

exp$3.sv = exp$l.top ? exp$l.encl ? RemoveFromSVList (Id , 

exp$l . sv) 

: SVCons (Id, exp$l . sv) 

: exp$l.sv; 

exp$3.encl = exp$l.encl; 
exp$2.encl = exp$l.encl; 
exp$2.top = false; 
exp$3.top = exp$l.top; 



/* Alternative unparsing */ 

exp : Let [ ' : := " # /.{‘/.L'/.S (KEYWORD : let'/.S) " <5 f inalTypeScheme 

" = °/.o" © " # /.S (KEYWORD :in , /,S)‘/.t , /.t , /.n" © " ’/.b'/.b’/.n 
’/. S (KEYWORD : end’/.S) ’/.b'/J" ] 

I LetVar [ “ : := "U’/.L’/.S (KEYWORD : letvarXS) " @ 

tau " var := %o" <9 " °/.S (KEYWORD : in , /„S) , /„t‘/„ty o n" @ 
"%b'/,b’/,n t /,S (KEYWORD : end’/.b'/.S )“/„}" ] 



/* Does id occur free in a \-abstraction in e? */ 

BOOL FreelnLambda (ID id, exp e) { 
with (e) ( 

AddrOf(e) : FreeInLambda(id, e) , 

Subscript (el , e2) :FreeInLambda(id, el) II FreeInLambda(id, e2) , 
Assign(el, e2) : FreeInLajnbda(id , el) || FreelnLambda (id, e2) , 

PtrAdd(el, e2) : FreeInLambda(id, el) II FreeInLambda(id , e2) , 

Deref(e) : FreeInLambda(id, e) , 

Lambda(*,*) : Freeln(id, e) , 
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Let (* , el , e2) 
LetVar (* , el , e2) 
LetArr(* , el ,e2) 
Compose(el,e2) 
Not (e) 

And(el , e2) 
0r(el,e2) 

Equal (el , e2) 
NotEqual (el ,e2) 



FreeInLambda(id, el) || FreeInLambda(id , e2) , 

: FreeInLambda(id , el) || FreeInLambda(id, e2) , 
: FreeInLambda(id , el) || FreeInLambda(id, e2) , 
: FreeInLambda(id , el) II FreeInLambda(id, e2) , 
FreeInLambda(id , e) , 

FreeInLambda(id, el) II FreeInLambda(id , e2) , 
FreeInLambda(id , el) || FreeInLambda(id, e2) , 

: FreeInLambda(id, el) II FreeInLambda(id, e2) , 
FreeInLambda(id, el) II FreeInLambda(id, e2) , 



Cond(el ,e2,e3) : FreeInLambda(id, el) || FreeInLambda(id, e2) 

II FreeInLambda(id, e3) , 



While(el , e2) 
Sum(el,e2) : 
Diff(el,e2) 
Prod(el,e2) 
Quot(el,e2) 
LessThaji(el ,e2) 



: FreeInLambda(id, el) || FreeInLambda(id, e2) , 
FreeInLambda(id, el) || FreeInLambda(id, e2) , 
FreeInLambda(id, el) || FreeInLambda( id, e2) , 
FreeInLambda(id, el) I | FreeInLambda(id, e2) , 
FreeInLambda(id, el) || FreeInLambda(id, e2) , 

: FreeInLambda(id, el) II FreeInLambda(id, e2). 



LessThanOrEqual(el , e2) : 

FreeInLambda(id, el) II FreeInLambda(id, e2) , 
GreaterThan(el ,e2) : FreeInLambda(id, el) || FreeInLajnbda(id , e2) , 
GreaterThan0rEqual(el,e2) : FreeInLambda(id, el) I I 
FreeInLambda(id, e2) , 

Pair(el,e2) : FreeInLambda(id, el) || FreeInLambda(id, e2) , 
Call(e,l) : FreeInLambda(id, e) || FreelnLambdaList (id, 1), 
default : false /* constants and placeholders */ 

) 



>; 



BOOL FreelnLambdaList (ID id, actualParamList 1) { 
with(l) ( 

ActualParamListPair(e, rest) : 

(FreeInLambda(id, e) || FreelnLambdaList (id, rest)), 
default : false 

) 



BOOL Freeln (ID id, exp e) { /* Does id occur free in e? */ 
with (e) ( 

Ident (Identif ier(x) ) : id == x, 

AddrOf(e) : Freeln(id, e) , 

Subscript (el , e2) :FreeIn(id, el) || Freeln(id, e2) , 
Assign(el, e2) : Freeln(id, el) || Freeln(id, e2) , 
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PtrAdd(el, e2) : Freeln(id, el) II Freeln(id, e2) , 

Deref(e) : Freeln(id, e) , 

Lambda(f, el) : !OccursIn(id, f) && Freeln(id, el). 

Let (Identif ier(x) , el, e2) : Freeln(id, el) II 

(Freeln(id, e2) && id != x) , 
LetVar(Identif ier(x) , el, e2) : Freeln(id, el) || 

(Freeln(id, e2) && id ! = x) , 
LetArr(*,el,e2) : Freeln(id, el) || Freeln(id, e2) , 
Compose(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

Not(el) : Freeln(id, el), 

And(el, e2) : Freeln(id, el) II Freeln(id, e2) , 

Or(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

Equal(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

NotEqual(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

Cond(el, e2, e3) : Freeln(id, el) || Freeln(id, e2) II 

Freeln(id, e3) , 

While(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

Sum(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

Diff(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

Prod(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

Quot(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

LessThan(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

LessThanOrEqual(el , e2) : Freeln(id, el) || Freeln(id, e2) , 
Great erThan (e 1 , e2) : Freeln(id, el) II Freeln(id, e2) , 

Great erThanOrEqual (e 1 , e2) : Freeln(id, el) II Freeln(id, e2) , 
Pair(el, e2) : Freeln(id, el) || Freeln(id, e2) , 

Call(e,l) : Freeln(id,e) II FreeInList(id, 1), 
default: false /* constants and placeholders */ 

) 



BOOL OccursIn(ID id, f ormalParamList 1) { 
with (1) ( 

FormalParamListPair(Identif ier(x) , rest) : 

((x == id) || OccursIn(id, rest)), 
default : false 

) 

}; 

BOOL FreeInList(ID id, actualParamList 1) { 
with(l) ( 

ActualParamListPair(e, rest) : 
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(Freeln(id, e) II FreelnList (id, rest)), 
default : false 

) 

>; 






* File Name : letarr.ssl * 

* Purpose : Definitions for letarr, pointer arithmetic and * 

* array indexing. We make a minor change to Poly C * 

* syntax: and denote pointer arithmetic with special * 

* character \oplus which is a plus sign + and a circle * 

* around it. But in template panel of the editor this * 

* sign will be seen as o+ because the current SynGen * 

* environment can not display this special character * 

* appropriately. * 






/* Abstract syntax */ 

exp : LetArr(Id exp exp) 

I PtrAdd(exp exp) 

I Subscript (exp exp) 

I SubscriptL(exp exp) /* For internal use only. */ 



/* Minimal parenthesization -- 
exp : LetArr { 

exp$2 .precedence = 0; 
exp$3. precedence = 0; 

} 

I PtrAdd PP2(6) 

I Subscript PP2(0) 



*/ 



/* Unparsing */ 

exp : LetArr [ “ "°/.S (KEYWORD : letarr’/.S) " © "["©"]" 

" */.S (KEYWORD : in°/„S) Xt/.t'/.n" © " ( / 0 b 0 /.b ( /,n%S (KEYWORD :end°/.S)" ] 
| PtrAdd [ “ ::= "%S (PUNCTUATION:" lp '7.S)" <9 "“/.S (OPERATOR: 

\<oplus> # /,S)'/,o " © " ( /.S (PUNCTUATION:" rp "‘/.S) 8 /.}" ] 

| Subscript [ “ : := "%{" © "[" <9 ] 

I SubscriptL [ ~ : := © " [" <9 ] 
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/* Template commands */ 

transform exp 

on "letarr" <exp>: LetArr(<Id>, <exp>, <exp>) , 

on "letarr<Id><exp>e" e when (e != <exp>) : LetArr(<Id>, <exp>, e) , 
on "letarr<Id>e<exp>" e when (e != <exp>) : LetArr(<Id>, e, <exp>) , 
on "\<oplus>" <exp> : PtrAdd(<exp> , <exp>) , 
on "[ ]" <exp> : Subscript (<exp> , <exp>) 



/* Concrete input syntax */ 

Exp ::= (LETARR id '['Exp']’ IN Exp END) { 

Exp$l.abs = LetArr(id.abs, Exp$2.abs, Exp$3.abs); 

> 



(Exp PTRADD Exp) {Exp$l.abs = PtrAdd( Exp$2.abs, Exp$3.abs); } 
(Exp '['Exp']') -(Exp$l.abs = Subscript (Exp$2 . abs, Exp$3.abs);} 



/^?K + ^ + ^** + *^^^^+ + *+** + ** + * + *** + * + + *** + *+**+ + * + ***** + + ******* + * + ***5k** 

* File Name : letarr. ssl * 

* Purpose : Type inference for letarr, pointer arithmetic and * 

* array indexing. * 

exp : LetArr { 

exp$l.S = exp$3.S; 

exp$l .typeAssignment = exp$3 .typeAssignment ; 

exp$l .partial = Id. partial II exp$2 .partial II exp$3 .partial ; 

exp$2.s = exp$l.s; 

exp$2 . letvars = exp$l . letvars ; 

exp$3 . letvars = RemoveFromLVList (Id, exp$l . letvars) ; 
exp$2 .typeEnv = exp$l .typeEnv; 

exp$3.s = Unify (exp$2 .typeAssignment , IntType ,exp$2 .S) ; 
exp$3 .typeEnv = 

TypeEnvConcat ( Id . name , TypeExp (Ref Type (TypeVar ( 
WeakVar(newsymi() ) ) ) ) , ApplySubstToTypeEnv(exp$2 .S , 

Remo veFromTypeEnv (Id. name, exp$l .typeEnv)) ) ; 
exp$2.sv = exp$l.sv; 
exp$3.sv = exp$l.top ? exp$l.encl ? 

RemoveFromSVList (Id, exp$l.sv) 

: SVCons(Id, exp$l . sv) 

: exp$l.sv; 
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exp$3.encl = exp$l . end ; 
exp$2.encl = exp$l . end ; 
exp$2.top = false; 
exp$3.top = exp$l.top; 

> 

I PtrAdd { 

exp$2 .typeEnv = exp$l .typeEnv; 
exp$2 . letvars = exp$l .letvars; 
exp$3 .letvars = exp$l .letvars ; 
exp$2.s = exp$l.s; 

exp$3.s = Unify (Ref Type(TypeVar (WeakVar(newsymi ()))) , 
exp$2 .typeAssignment , exp$2.S); 
exp$3 .typeEnv = ApplySubstToTypeEnv(exp$3 . s , exp$l .typeEnv) ; 
exp$l.S = Unify(exp$3. typeAssignment, IntType, exp$3.S); 
exp$l .typeAssignment = 

ApplySubstToTypeExp(exp$l .S, exp$2 .typeAssignment) ; 
exp$l .partial = exp$2 .partial II exp$3 .partial ; 
exp$3 . end = exp$ 1 . end ; 
exp$2.end = exp$l.encl; 
exp$2.top = false; 
exp$3.top = exp$l.top; 
exp$2.sv = exp$l.sv; 
exp$3.sv = exp$l.sv; 

> 

I Subscript { 

local TYPEEXP tau; 
exp$2 .typeEnv = exp$l .typeEnv; 
exp$2 . letvars = exp$l .letvars; 
exp$3 . letvars = exp$l .letvars ; 
exp$2.s = exp$l.s; 

exp$3.s = Unify (RefType(TypeVar(WeakVcLr(newsymi()))) , 
exp$2 . typeAssignment , exp$2.S); 
exp$3 .typeEnv = ApplySubstToTypeEnv(exp$3 . s , exp$l .typeEnv) ; 
exp$l.S = Unify (exp$3 .typeAssignment , IntType, exp$3.S); 
exp$l .typeAssignment = 
with(tau) ( 

RefType(t) : t, 
default : NullType 

); 

exp$l .partial = exp$2 .partial II exp$3. partial; 

tau = ApplySubstToTypeExp(exp$l . S , exp$2 . typeAssignment) ; 

exp$3.encl = exp$l.encl; 
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exp$2.encl = exp$l.encl; 
exp$2.top = false; 
exp$3.top = exp$l.top; 
exp$2.sv = exp$l.sv; 
exp$3.sv = exp$l.sv; 

> 

I Subscript!. { 

INHSILENCE(exp$2) /* this attribution is a result */ 
INHSILENCE(exp$3) /* of values being expressions */ 
SYNSILENCE(exp$l) 



/* Alternative unparsing */ 

exp : PtrAdd { 

in TypeErrors on (exp$l.S == FailSubst && 

exp$2.S != FailSubst && exp$3.S != FailSubst); 

} [ TypeErrors @ : "PtrAdd°/ 0 n" ] 

I Subscript { 

in TypeErrors on (exp$l.S == FailSubst && 
exp$2.S != FailSubst); 

} [ TypeErrors @ : "Subscript # /n" ] 



* File Name : lex.ssl * 

* Purpose : Lexical syntax, token precedences for concrete input * 

* syntax and style declarations. * 

/* Lexical syntax */ 

WHITESPACE : WhiteSpaceLex < [\ \t\n] >; 

EXP_PLACEHOLDER: ExpPlaceholderLex < "<exp>" >; 

IDENTIFIER.PLACEHOLDER: Identif ierPlaceholderLex < "<identif ier>" > 

LAMBDA : LambdaLex < "lambda" | "LAMBDA" | {lambda} >; 

VAL : ValLex < "val" | "VAL" >; 

FIX : FixLex < "fix" >; 
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LET 

LETVAR 

LETARR 

IN 

NIL 

IF 

WHILE 

UNIT 

THEN 

ELSE 

DO 

OD 

FI 

BEGIN 

END 

TRUE 

FALSE 

ASSIGN 

LOGICALAND 

LOGICALOR 

NOTEQUAL 

LESSEQUAL 

GREATEREQUAL 

INTEGER 

FLOAT 

ID 

PTRADD 



LetLex 

LetVarLex 

LetArrLex 

InLex 

NilLex 

IfLex 

WhileLex 

UnitLex 

ThenLex 

ElseLex 

DoLex 

OdLex 

FiLex 

BeginLex 

EndLex 

TrueLex 

FalseLex 

AssignLex 

LogicalAnd 

LogicalOr 



< "let" > ; 

< "letvar" >; 

< "letarr" >; 

< "in" | "IN" > ; 

< "nil" | " [] " > ; 

< "if" | "IF" > ; 

< "while" | "WHILE" >; 

< "unit" > ; 

< "then" | "THEN" >; 

< "else" | "ELSE" >; 

< "do" | "DO" > ; 

< "od" I "OD" >; 

< "f i" | "FI" > ; 

< "begin" I "BEGIN" >; 

< "end" I "END" >; 

< "true" | "TRUE" >; 

< "false" | "FALSE" >; 

< ":=" > ; 

< "&&" > ; 

< "II" > ; 



NotEqualLex < "<>"|{ne} >; 

LessEqualLex < "<="|{le} >; 

Great erEqualLex < ">=" Kge} >; 

IntegerLex < \-?[0-9]+ >; 

FloatLex < [0-9] * (\ . [0-9] *) ( [dDeE] [-+] ? [0-9] +) ?> ; 

IdLex < [A-Za-z] [0-9A-Za-z_$] *[’]*! [?] > ; 

PtrAddLex < {oplus} >; 



/* Token precedences for concrete input syntax */ 

left LOGICALOR; 
left LOGICALAND; 
nonassoc NOTEQUAL; 

nonassoc >= ; , ><>, LESSEQUAL, ’>' , GREATEREQUAL; 
left PTRADD, , »-» ; 
left »*», V’; 
right ‘ k ’ , ’ ! ’ , ‘ ~ ’ ; 

nonassoc ID, VAL, FIX, IN, NIL, TRUE, FALSE, FLOAT, INTEGER, LET, 
LETVAR, LETARR, IF, WHILE, UNIT, THEN, ELSE, DO, OD, FI, 
BEGIN, END, ASSIGN, LAMBDA, EXP_PLACEHOLDER ; 
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/* Style declarations 

style NORMAL, KEYWORD, PLACEHOLDER, PUNCTUATION, OPERATOR; 



*/ 



* File Name : newsymi.c * 

* Purpose : New type variable generator. * 

***********:***** ********************** Jit************************ *****/ 

/* $Revision: 1.2 $ 

* $Date : 1993/09/02 21:21:12 $ 

* $Author: volpano $ 

* $Log: newsymi.c, v $ 

* Revision 1.2 1993/09/02 21:21:12 volpano 

* Removed T in sprintf. 

* 

*/ 

/* 

* Copyright (c) 1989, an unpublished work by GrammaTech, Inc. 

* ALL RIGHTS RESERVED 

* 

* This software is furnished under a license and may be used and 

* copied only in accordance with the terms of such license and the 

* inclusion of the above copyright notice. This software or any 

* other copies thereof may not be provided or otherwise made 

* available to any other person. Title to and ownership of the 

* software is retained by GrammaTech, Inc. 

*/ 

#include "str0_exp.h" 

#include "structures_exp .h" 

#include "types_exp .h" 

/* 

* newsymi 

* 

* Generate new unique symbol . 

* 

* WARNING: In general, this is not a good technique, because 

* gratuitous new symbols will cause AFFECTED to be too large. 

*/ 



105 



FOREIGN newsymiO 

{ 

static int i; 
static char buff[lO]; 

sprintf (buf f , "*%!" , i++) ; 
return(Str(str_to_strO (buff) ) ) ; 

} 



* File Name : pair.ssl * 

* Purpose : Defitions for pair. Pair is the stdout of the * 

* interpreter. We output the result produced by a * 

* program through pair construct . One might consider * 

* using list construct for this purpose. But a list * 

* requires the elements have the same which is a severe * 

* restriction. Notice that we define only the required * 

* constructor and do not define first and second * 

* operations since pair is not in Poly C calculus they * 

* are not needed. * 

/* Abstract syntax */ 

exp : Pair(exp exp) 

) 

/* Minimal parenthesization */ 

exp : Pair { 

exp$2 .precedence = 0; 
exp$3 .precedence = 0; 

> 

i 

/* Unparsing */ 

exp : Pair [ ~ "'/.S (PUNCTUATION : (*/.S)" <§ 

'7.S (PUNCTUATION : ,°/.S) */,o" 0 "°/.S (PUNCTUATION : ) %S) " ] 

) 

/* Template commands */ 

transform exp 
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on "( , )" <exp> : Pair(<exp> , <exp>) 



/* Concrete input syntax */ 

Exp ::= (’(' Exp Exp ’)’) {$$.abs = Pair(Exp$2.abs, Exp$3.abs);} 



+ + + + + + + + + + + + + + + + + + + + + ^ + ^ + + + + + + + + + + 

* File Name : pair_inf er . ssl * 

* Purpose : Type inference for pair. * 

exp : Pair { 

exp$2 .typeEnv = exp$l .typeEnv; 
exp$2 .letvars = exp$l . letvars ; 
exp$3 .letvars = exp$l . letvars ; 
exp$2.s = exp$l.s; 

exp$3. typeEnv = ApplySubstToTypeEnv(exp$2.S, exp$l .typeEnv) ; 
exp$3.s = exp$2.S; 

exp$l .partial = exp$2 .partial II exp$ 3 .partial; 
exp$ 1 . S = exp$3 . S ; 

exp$l .typeAssignment = PairType(exp$2.typeAssignment, 

exp$3 .typeAssignment) ; 

exp$3.top = false; 
exp$2.top = false; 
exp$3.encl = exp$l.encl; 
exp$2.encl = exp$l.encl; 
exp$3.sv = exp$l.sv; 
exp$2.sv = exp$l.sv; 

> 



/ ******** **************** ******************************************** 

* File Name : real. ssl * 

* Purpose : Definitions for real numbers. * 

*/ 



/* Abstract syntax 



exp : RealOp(REAL) [ : ] 



/* Concrete input syntax */ 

Exp ::= (FLOAT) { Exp$l.abs = RealOp (STRtoREAL (FLOAT) ) ; > 



* File Name : real_inf er . ssl * 

* Purpose : Type inference for real numbers. * 

exp : RealOp { 

exp .typeAssignment = RealType; 

exp . S -= exp . s ; 

exp. partial = false; 

> 



* File Name : while. ssl * 

* Purpose : Definitions for while loop. * 

******************************************************************** / 

/* Abstract syntax */ 

exp : While(exp exp); 

/* Minimal parenthesization */ 

exp : While { 

exp$2 .precedence = 0; 
exp$3 .precedence = 0; 

> 



/* Unparsing */ 

exp : While [~ : := "“/.t'/.S (KEYWORD : while 0 /, S) " <§ " ”/.S (KEYWORD : do°/,S) \n" 

@ '7.by„ny,S (KEYWORD : od'/.S) "] 



/* Template commands */ 

transform exp 
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on "while" e : While(<exp>, e) 



/* Concrete input syntax */ 

Exp : := (WHILE Exp DO Exp OD) 

{ Exp$l.abs = While (Exp$2.abs, Exp$3.abs); } 



+ + + ^ + + + + + ^ + + + + ^ + + ^ + + + ^ + + ^ + ^ + ^ + + + + + + + + + + + + + 

* File Name : while_inf er . ssl * 

* Purpose : Type inference for while loop. * 

********************************************************************/ 

/* type inference */ 
exp : While { 

exp$2 . typeEnv = exp$l .typeEnv; 
exp$2 . letvars = exp$l . letvars ; 
exp$3 . letvaxs = exp$l . letvaxs ; 
exp$2.s = exp$l.s; 

exp$3.s = Unify (exp$2 .typeAssignment , IntType, exp$2.S); 

exp$3 .typeEnv = ApplySubstToTypeEnv(exp$3. s 3 exp$l .typeEnv) ; 

exp$l.S = exp$3.S; 

exp$l . typeAssignment = UnitType; 

exp$l .partial = exp$2 .partial II exp$3. partial; 

exp$3.encl = exp$l.encl; 

exp$2.encl = exp$l.encl; 

exp$3.sv = exp$l.sv; 

exp$2.sv = exp$l.sv; 

exp$2.top = false; 

exp$3.top = false; 

> 



exp : While 

{ in TypeErrors on (exp$3.s == FailSubst kk 

exp$2.S != FailSubst); } 
[ TypeErrors 0 : "While’/.n" ] 
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